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

赞 (0)

相关推荐

  • 利用webqq协议使用python登录qq发消息源码参考

    开源的,地址在https://github.com/atupal/webqq 等有时间了写一个完整的cli qq客户端. 使用方法:python login_qq.py即可 复制代码 代码如下: import urllib2 import httplib2 import re import random from encryption import QQmd5 import cookielib import requests import getpass import time import j

  • 用VBScript制作QQ自动登录的脚本代码

    一直用的是狂人版的QQ,也用它附赠的自动登录器很久了,不过最近一版的狂人QQ不知为何取消了自动登录组件.好在QQ2009已经能够同时记住多个号码的密码,虽然要多点击几下,但依然能够实现免输入密码登录. 谁知最近不知道电脑发了什么疯,每隔一段时间,QQ记住的密码就会被清空.我的两个QQ号密码都设置得比较复杂,每次登录要输入两遍密码实在是件痛苦的事情,于是决定自制一个登录器. 在网上找了许久,发现了一个用VBS制作QQ登录脚本的办法: 复制代码 代码如下: set WshShell = WScrip

  • vbs qq自动登录脚本改进版

    复制代码 代码如下: On Error Resume Next Dim WshShell, QQPath, QQselectset wshshell=createobject("wscript.shell")set fso=createobject("scripting.filesystemobject") key="HKLM\SOFTWARE\Tencent\PlatForm_TYPE_LIST\1\"QQPath=wshshell.regre

  • QQ登录背景闪动效果附效果演示源码下载

    QQ登录背景闪动效果附效果演示源码下载

    在前面时间更新的新版本QQ中,登录背景和以前不一样了,是一组闪动的背景,效果非常棒. 效果演示     源码下载 改效果需要引入三个js文件: <script src="js/Jq-19.js" type="text/javascript"></script> <script src="js/cavas.js" type="text/javascript"></script> &

  • 禁止指定QQ号登录的bat代码(前提这个用户在这台机器登陆过)

    复制代码 代码如下: @echo off color f0 mode con cols=50 lines=20 echo *****前提是此QQ号在本机登录过**** set /p qqid=请输入要禁止登录的QQ号: for %%i in (c d e f g ) do ( if not exist %%i: exit for /f "tokens=*" %%j in ('dir /ad /b /s "%%i:\%qqid: =%"') do ( if exist

  • QQ登录 PHP OAuth示例代码

    根据官方文档编写 复制代码 代码如下: <?php /** * 申请http://connect.opensns.qq.com/apply * 列表http://connect.opensns.qq.com/my */ session_start(); $qq_oauth_config = array( 'oauth_consumer_key'=>'*******',//APP ID 'oauth_consumer_secret'=>'******************',//APP

  • QQ互联一键登录审核不通过的解决方案

    QQ互联一键登录审核不通过的解决方案

    在QQ互联上申请帐号之后提交了审核, 后台填写APPID和KEY之后自己申请的QQ号可以正常登录,但QQ互联审核的时候一直审核不通过说是"您的网站审核未通过,原因是"点击QQ登录按钮提示登录失败或出现错误信息(无跳转.提示失败.出现错误信息)",请确认申请符合审核标准后,再提交审核",或者是""禁止开发商强制用户重新注册或绑定其他帐号"". 错误提示图: Destoon爱好者对此问题的解决方案是:修改模板目录下的chip/li

  • python登录QQ邮箱发信的实现代码

    复制代码 代码如下: # -*- coding: cp936 -*-from email.Header import Headerfrom email.MIMEText import MIMETextfrom email.MIMEMultipart import MIMEMultipartimport smtplib, datetime#创建一个带附件的实例msg = MIMEMultipart()#构造附件att = MIMEText(open('f:\\文件名.doc', 'rb').rea

  • js如何调用qq互联api实现第三方登录

    qq互联js SDK:http://wiki.connect.qq.com/js_sdk%E4%BD%BF%E7%94%A8%E8%AF%B4%E6%98%8E 复制代码 代码如下: <script type=text/javascript> 在页面header中引入:<script type="text/javascript" src="http://qzonestyle.gtimg.cn/qzone/openapi/qc_loader.js"

  • 网站接入QQ登录的两种方法

    首先引入授权js文件 <script type="text/javascript" src="http://qzonestyle.gtimg.cn/qzone/openapi/qc_loader.js" data-appid="101140406" data-redirecturi="http://127.0.0.1" charset="utf-8"></script> 然后接入QQ

  • 使用java swing实现qq登录界面示例分享

    用Java Swing做的一个QQ登录界面 复制代码 代码如下: import java.awt.Container;import java.awt.Image;import java.awt.event.ActionEvent;import java.awt.event.ActionListener; import javax.swing.ImageIcon;import javax.swing.JButton;import javax.swing.JCheckBox;import javax

  • QQ多帐号自动登录批处理脚本

    复制代码 代码如下: '定义QQ程序路径.帐名.密码 Dim Program1,a,b Program1= "C:\Program Files\Tencent\QQ\Bin\QQ.exe" Set WshShell=createobject("wscript.shell") '运行QQ主程序 Set oExec=WshShell.Exec(Program1) WScript.Sleep 1000 '激活QQ窗口 WshShell.AppActivate "

随机推荐