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

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

2020-07-23 11:08VBS代码网 VBS

本文主要分享使用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