快捷導(dǎo)航

VBS取QQ或TM自動登錄代碼并防止關(guān)閉的腳本

更新時間：2008年06月25日 20:46:05 作者：

取TM自動登錄代碼并防止關(guān)閉(自動登錄)

'Dim QQUIN
Set objWMIService = GetObject _
                    ("winmgmts:\\" & "." & "\root\cimv2")
Set ps = objWMIService.ExecQuery _
         ("SELECT * FROM Win32_process")
For Each ps in ps '列出系統(tǒng)中所有正在運行的程序

    'for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ '列出系統(tǒng)中所有正在運行的程序
    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 "系統(tǒng)中沒有運行QQ或TM程序,請重新啟動QQ或TM,登陸后再使用一鍵換切換一下QQ或TM程序,再運行本腳本"
Else
    Do '循環(huán)檢測
        myqqin = chkuin(QQUIN) '檢測上面提取出來的QQ號碼是否有在本機打開
        If Not myqqin Then '如果沒有運行則,重新運行QQ程序并登錄
            runapp(AppPath) '
            wscript.sleep 10000 '等待10秒
        Else
            wscript.sleep 5000 '等待5秒
        End If
    Loop '返回繼續(xù)檢測
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 '列出系統(tǒng)中所有正在運行的程序

        '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

您可能感興趣的文章: