vbs qq自動登錄腳本改進版

On Error Resume Next
Dim WshShell, QQPath, QQselect
set wshshell=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
key="HKLM\SOFTWARE\Tencent\PlatForm_TYPE_LIST\1\"
QQPath=wshshell.regread(key"TypePath")
Set f = fso.getfile(QQPath)
fso.deletefile f.ParentFolder"\LoginUinList.dat"
WshShell.Run """"QQPath""""
do while WshShell.AppActivate("QQ用戶登錄")>True
wscript.sleep 500
loop
WScript.Sleep 1000
WshShell.AppActivate "QQ用戶登錄"

SendKeys "814116208"
WScript.Sleep 100
SendKeys "{TAB}"
WScript.Sleep 100
SendKeys "********"
WScript.Sleep 100
SendKeys "{ENTER}"
WshShell.Run """"QQPath""""
do while WshShell.AppActivate("QQ用戶登錄")>True
wscript.sleep 500
loop
WScript.Sleep 1000
WshShell.AppActivate "QQ用戶登錄"

SendKeys "371471521"
WScript.Sleep 100
SendKeys "{TAB}"
WScript.Sleep 100
SendKeys "********"
WScript.Sleep 100
SendKeys "{ENTER}"
sub sendkeys(keys)
wshshell.sendkeys keys,ture
end sub