'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