'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
