VBS取QQ或TM自动登录代码并防止关闭的脚本 |
本文标签:VBS,QQ,TM,自动登录代码 Dim QQUIN Set objWMIService = GetObject _ ("winmgmts:\\" & "." & "\root\cimv2") Set ps = objWMIService.ExecQuery _ ("SELECT * FROM Win32_process") For Each ps in ps 列出系统中所有正在运行的程序 for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ 列出系统中所有正在运行的程序 If LCase(ps.Name) = "qq.exe" Or LCase(ps.Name) = "tm.exe" Then 检测是否QQ或TM AppPath = ps.commandline 提取QQ程序的命行 tmp = Replace(AppPath, Chr(34), Space(1)) UIN1 = InStr(tmp, "QQUIN:") + 6 QQUIN = Mid(tmp, UIN1, InStr(UIN1, tmp, Space(1)) - UIN1) 取QQ号码. End If Next If Len(QQUIN) = 0 Then MsgBox "系统中没有运行QQ或TM程序,请重新启动QQ或TM,登陆后再使用一键换切换一下QQ或TM程序,再运行本脚本" Else Do 循环检测 myqqin = chkuin(QQUIN) 检测上面提取出来的QQ号码是否有在本机打开 If Not myqqin Then 如果没有运行则,重新运行QQ程序并登录 runapp(AppPath) wscript.sleep 10000 等待10秒 Else wscript.sleep 5000 等待5秒 End If Loop 返回继续检测 End If Function RunApp(AppPath) Dim obj Set obj = CreateObject("WScript.Shell") obj.exec(AppPath) End Function Function chkuin(QQUIN) Set objWMIService = GetObject _ ("winmgmts:\\" & "." & "\root\cimv2") Set ps = objWMIService.ExecQuery _ ("SELECT * FROM Win32_process") For Each ps in ps 列出系统中所有正在运行的程序 for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ If LCase(ps.Name) = "qq.exe" Or LCase(ps.Name) = "tm.exe" Then AppPatht = ps.commandline by chenall qq 368178720 tmp = Replace(AppPatht, Chr(34), Space(1)) UIN1 = InStr(tmp, "QQUIN:") + 6 QQUINTMP = Mid(tmp, UIN1, InStr(UIN1, tmp, Space(1)) - UIN1) If QQUINTMP = QQUIN Then chkuin = True End If End If Next End Function |