VBS取QQ或TM自动登录代码并防止关闭的脚本
时间:2020-07-23 11:08 来源/作者:VBS代码网
-
'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
相关文章
热门资讯