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