VBS取QQ或TM自动登录代码并防止关闭的脚本

1. 'Dim QQUIN     
2. Set objWMIService = GetObject _     
3.                     ("winmgmts:\\" & "." & "\root\cimv2")     
4. Set ps = objWMIService.ExecQuery _     
5.          ("SELECT * FROM Win32_process")     
6. For Each ps in ps '列出系统中所有正在运行的程序     
7.  
8.     'for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ '列出系统中所有正在运行的程序     
9.     If LCase(ps.Name) = "qq.exe" Or LCase(ps.Name) = "tm.exe" Then '检测是否QQ或TM     
10.         AppPath = ps.commandline '提取QQ程序的命行     
11.         tmp = Replace(AppPath, Chr(34), Space(1))     
12.         UIN1 = InStr(tmp, "QQUIN:") + 6     
13.         QQUIN = Mid(tmp, UIN1, InStr(UIN1, tmp, Space(1)) - UIN1) '取QQ号码.     
14.     End If    
15. Next    
16. If Len(QQUIN) = 0 Then    
17.     MsgBox "系统中没有运行QQ或TM程序,请重新启动QQ或TM,登陆后再使用一键换切换一下QQ或TM程序,再运行本脚本"    
18. Else    
19.     Do '循环检测     
20.         myqqin = chkuin(QQUIN) '检测上面提取出来的QQ号码是否有在本机打开     
21.         If Not myqqin Then '如果没有运行则,重新运行QQ程序并登录     
22.             runapp(AppPath) '     
23.             wscript.sleep 10000 '等待10秒     
24.         Else    
25.             wscript.sleep 5000 '等待5秒     
26.         End If    
27.     Loop '返回继续检测     
28. End If    
29.  
30. Function RunApp(AppPath)     
31.     Dim obj     
32.     Set obj = CreateObject("WScript.Shell")     
33.     obj.exec(AppPath)     
34. End Function    
35.  
36. Function chkuin(QQUIN)     
37.     Set objWMIService = GetObject _     
38.                         ("winmgmts:\\" & "." & "\root\cimv2")     
39.     Set ps = objWMIService.ExecQuery _     
40.              ("SELECT * FROM Win32_process")     
41.     For Each ps in ps '列出系统中所有正在运行的程序     
42.  
43.         'for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_     
44.         If LCase(ps.Name) = "qq.exe" Or LCase(ps.Name) = "tm.exe" Then    
45.             AppPatht = ps.commandline     
46.             'by chenall qq 368178720     
47.             tmp = Replace(AppPatht, Chr(34), Space(1))     
48.             UIN1 = InStr(tmp, "QQUIN:") + 6     
49.             QQUINTMP = Mid(tmp, UIN1, InStr(UIN1, tmp, Space(1)) - UIN1)     
50.             If QQUINTMP = QQUIN Then chkuin = True End If    
51.         End If    
52.     Next    
53. End Function