我不怕QQ多！多QQ启动脚本

王朝other·作者佚名 2006-01-09

宽屏版字体: 小|中|大|超大

Dim WshShell, QQPath, QQselect,askem,MyTime

Set WshShell=WScript.CreateObject("WScript.Shell")

'------------------要修改的地方共4处，下面三行各有一处-------------------------

Dim NumArray(4),PassArray(4) '括号内的数字比QQ个数少1

QQPath="E:\XP\Tencent\QQ\QQ.exe" 'QQ安装目录

MyTime = 14000 '关闭前一QQ的延时，如果QQ上线较慢，改大点

NumArray(0)= "41729237" '以下填上你QQ号和密码

PassArray(0)= "88888"

NumArray(1)= "164069728"

PassArray(1)= "88888"

NumArray(2)= "164069501"

PassArray(2)= "88888"

NumArray(3)= "396795254"

PassArray(3)= "88888"

NumArray(4)= "249883454"

PassArray(4)= "88888"

'还有QQ的话尽量加！

askem = msgbox ("在本程序运行完毕前，请勿进行其他操作" & vbnewline & vbnewline & "作者：独生" _

& vbnewline & "http://hyycts.com/wltm/main.asp" & vbnewline & vbnewline & "确定运行请按是，反之否" , _

vbyesno + vbExclamation)

if askem = vbyes then

'------------------要修改的地方共4处，下面一行有一处-------------------------

For i=0 to 4 'to 后跟的数字比QQ个数少1

Logon

Kill(MyTime)

WScript.Echo "全部QQ启动完毕,可以进行其他操作了"

else

wscript.quit

end if

Set WshShell=Nothing

Sub Logon()

WScript.Sleep 500

WshShell.Run QQPath

WScript.Sleep 2000

WshShell.AppActivate "Q登录"

WshShell.SendKeys "+{TAB}"

WshShell.SendKeys NumArray(i)

WScript.Sleep 200

WshShell.SendKeys "{TAB}"

WshShell.SendKeys PassArray(i)

WScript.Sleep 200

WshShell.SendKeys "{ENTER}"

WScript.Sleep 200

WshShell.SendKeys "{ENTER}"

End Sub

Function Kill(Time)

WScript.Sleep Time

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set ProcessList = objWMIService.ExecQuery _

("Select * from Win32_Process Where Name = 'QQ.exe'")

For Each objProcess in ProcessList

objProcess.Terminate()

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set ProcessList = objWMIService.ExecQuery _

("Select * from Win32_Process Where Name = 'TIMPlatform.exe'")

For Each objProcess in ProcessList

objProcess.Terminate()

End Function