用VB实现的QQ自动登录器

'在VB中建一工程，工程名为QQAutoLogin。移除系统自动添加的窗体Form1。在该工程下添加一模块，模块名为QQAutoLoginMod。复制以下代码到模块中。
Option Explicit
'-----------------------API 定义-------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetFocus Lib "user32" () As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
'-----------------------结构定义-------------------------------
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'-----------------------常量定义-------------------------------
Const WM_SETTEXT = &HC
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Const KEYEVENTF_KEYUP = &H2
Const SW_SHOWNORMAL = 1

Dim QQ_ExeFileName As String 'QQ.exe全路径文件名
Dim QQ_MainhWnd As Long 'QQ登录窗口句柄
Dim QQ_NumEdithWnd As Long 'QQ号码框句柄
Dim QQ_PwdEdithWnd As Long 'QQ密码柄句柄
Private Function QQ_AutoPressKey(hWnd As Long, strKey As String)
    Dim nLength As Long, VKey As Long, i As Long

    strKey = UCase(strKey)
    nLength = Len(strKey)


    For i = 1 To nLength
        VKey = Asc(Mid(strKey, i, 1))
        Call AutoPressKey(VKey)
    Next
End Function
Public Function AutoPressKey(VKey As Long)
    keybd_event VKey, 0, 0, 0 '模拟键按下
    keybd_event VKey, 0, KEYEVENTF_KEYUP, 0 '模拟键弹起
End Function

Private Function QQ_GetMainhWnd()
EnumWindows AddressOf QQ_EnumMainhWndProc, 0 '枚举所有顶层窗口
End Function

Private Function QQ_EnumMainhWndProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
    Dim nPID As Long, nTID As Long
    Dim hProcess As Long, strFileName As String

    nTID = GetWindowThreadProcessId(hWnd, nPID) '根据窗口句柄获得拥有窗口的进程ID和线程ID
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, nPID) '根据进程ID打开进程获得进程句柄
    strFileName = Space(255)
    GetModuleFileNameEx hProcess, 0, strFileName, 255 '根据进程句柄获得进程主模块文件名
    If Left$(strFileName, InStr(1, strFileName, Chr(0)) - 1) = QQ_ExeFileName Then
        If IsWindowVisible(hWnd) Then '整个QQ.exe登录期间只有登录窗口是可见的
            QQ_MainhWnd = hWnd
            QQ_EnumMainhWndProc = False '枚举函数返回False结束循环枚举
            CloseHandle hProcess
            Exit Function
        End If
    End If
    CloseHandle hProcess

    QQ_EnumMainhWndProc = True
End Function
Private Function QQ_GetSubhWnd()
    EnumChildWindows QQ_MainhWnd, AddressOf EnumSubhWndProc, 0 '枚举QQ登录窗口下的所有子窗口
End Function

Private Function EnumSubhWndProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim stRect As RECT, nWidth As Long, nHeight As Long
    Dim strClassName As String * 255, tmphWnd As Long

    GetClientRect hWnd, stRect '取得窗口客户区距形区域大小
    nWidth = stRect.Right - stRect.Left
    nHeight = stRect.Bottom - stRect.Top

    strClassName = Space(255)
    GetClassName hWnd, strClassName, 255 '根据窗口句柄获得窗口类名
    Select Case Left$(strClassName, InStr(1, strClassName, Chr(0)) - 1)
    Case "Edit" '如果该窗口是文本框类
        tmphWnd = GetParent(hWnd) '获得该窗口的父窗口
        strClassName = Space(255)
        GetClassName tmphWnd, strClassName, 255 '取得父窗口类名
        If tmphWnd <> QQ_MainhWnd Then '如果该子窗口的父窗口不是QQ登录窗口的话
            '注意:QQ号码框被设计在一个ComboBox类的组合框中。
            '父子关系如下:QQ登录窗口__ComboBox(父窗口为QQ登录窗口)__QQ号码框(父窗口为ComboBox)
            '这种关系在QQ登录窗口中是唯一的，要查找QQ号码框要满足的条件如下:
            '1:类名必须是Edit 2:父窗口类名必须是ComboBox
            If Left$(strClassName, InStr(1, strClassName, Chr(0)) - 1) = "ComboBox" Then
                '加多一层检查,QQ号码框的距形大小，这个也是唯一的。
                '其实单单检查这个也可以查找到QQ号码框
                '注意这个会随着QQ版本的不同可能会有所不同，因为QQ的界面腾迅一直使其在变(漂亮)
                If nWidth = 127 And nHeight = 14 Then
                    QQ_NumEdithWnd = hWnd
                End If
            ElseIf Left$(strClassName, InStr(1, strClassName, Chr(0)) - 1) = "#32770" Then
                '要查找QQ密码框要满足的条件如下:
                '1:类名必须是Button 2:父窗口类名必须是#32770(对话框)
                '注意以上两个并不是唯一的，必须加多以下一层检查
                If nWidth = 131 And nHeight = 14 Then '单单检查这个也可以，这个是唯一的(2007版)
                    QQ_PwdEdithWnd = hWnd
                End If
            End If
        End If
    Case "Button"
        'If nWidth = 75 And nHeight = 21 Then
            'MsgBox "登录框"
        'End If
    End Select

    EnumSubhWndProc = True
End Function
Public Function QQ_AutoLogin(strExeFileName As String, strNum As String, strPwd As String)
    Shell strExeFileName    '外部运行QQ.exe
    Sleep 1000 '延时1000毫秒
    QQ_MainhWnd = 0 '初始化登录窗口句柄
    Call QQ_GetMainhWnd '获取QQ登录窗口句柄(自定义函数)
    If QQ_MainhWnd Then Debug.Print "成功获得主窗口句柄" '调试语句，可删除
    QQ_NumEdithWnd = 0 '初始化号码框和密码框句柄
    QQ_PwdEdithWnd = 0
    If QQ_MainhWnd Then Call QQ_GetSubhWnd '获取QQ号码框和密码框句柄(自定义函数)
    If QQ_NumEdithWnd And QQ_PwdEdithWnd Then Debug.Print "成功获得号码框和密码框句柄" '调试语句，可删除
    SendMessage QQ_NumEdithWnd, WM_SETTEXT, 0, 0 '清空号码框
    '有人问为什么不用SetFocus直接设置焦点而用模拟按下Tab键，那是因为QQ不响应获得焦点消息，调用SetFocus达不到效果
    '还有一个在QQ登录窗口Tab键只在号码框和密码框之间来回切换，不信你试一下
    Call SetForegroundWindow(QQ_MainhWnd) '保证模拟键盘输入之前QQ登录窗口的显示状态
    If GetFocus() <> QQ_NumEdithWnd Then Call AutoPressKey(vbKeyTab) '保证模拟键盘输入之前焦点在号码框
    Call QQ_AutoPressKey(QQ_NumEdithWnd, strNum) '模拟键盘自动输入QQ号码
    Sleep 500
    If GetFocus() <> QQ_PwdEdithWnd Then Call AutoPressKey(vbKeyTab) '保证模拟键盘输入之前焦点在密码框
    Call QQ_AutoPressKey(QQ_PwdEdithWnd, strPwd) '模拟键盘自动输入QQ密码
    Sleep 500
    Call AutoPressKey(vbKeyReturn) '模拟键盘输入回车键开始登录
End Function

Sub Main()
    Dim strNum As String, strPwd As String

    strNum = "4598456"
    strPwd = "nihaoma"
    QQ_ExeFileName = "D:/Program Files/Tencent/QQ/QQ.exe"
    Call QQ_AutoLogin(QQ_ExeFileName, strNum, strPwd) 'QQ自动登录函数(自定义函数)
End Sub

'程序还有以下几个致命的缺陷:
'1:如果在该程序运行之前已经有QQ程序在运行(未登录或已登录的)，那判断QQ登录主窗口的代码就可能会不正确了
'2:模拟键盘输入那地方还有点问题,在模拟的中间有可能被别的程序打断,一失去焦点就乱了

用VB实现的QQ自动登录器相关推荐

QQ自动登录/QQ登录器/程序源代码/VS2010/VS2012/VC/MFC
学习豪迪,研究了一下QQ自动登录怎么写. 以前QQ登录的介面先用SPY++来找到QQ登陆框,然后再把密码copy进去,就可以了. 现在的QQ登录介面这招不行,用SPY++是找不到任何ID的. 怎办呢? ...
python 游戏脚本 vbs_用VBScript制作QQ自动登录的脚本代码
一直用的是狂人版的QQ,也用它附赠的自动登录器很久了,不过最近一版的狂人QQ不知为何取消了自动登录组件.好在QQ2009已经能够同时记住多个号码的密码,虽然要多点击几下,但依然能够实现免输入密码登录. ...
利用phantomjs模拟QQ自动登录
之前为了抓取兴趣部落里的数据,研究了下QQ自动登录. 当时搜索了一番,发现大部分方法都已经失效了,于是准备自己开搞. 第一个想到的就是参考网上已有方案的做法,梳理登陆js的实现,通过其他语言重写. 考 ...
求QQ自动登录解决方案
QQ2010现在不支持命令行登录了,还有如果是模拟鼠标键盘的话,如何确定输入框的位置先FindWindow找到登陆框,GetWindowRect就可以计算机了顶到有人帮忙解决为止没人知道吗?现在有 ...
QQ自动登录Autojs源码分享
auto.waitFor(); checkUpgrade(); main();function main() {//启动QQsleep(1500);app.launchPackage("co ...
radmin自动启动服务器,Radmin自动登录器及服务端一键部署
在 Radmin一键安装 .exe 的火眼报告中,有几个关键性的动作,在这里我跟大家说明一下,这并非我的程序所为,而是Radmin服务端自身的文件在安装时对系统产生的一些动作. 因上一版本界面实在太丑 ...
python实现qq自动登录虎牙并发弹幕
博主是python小白一枚. 项目是参考白月黑羽的python学习网站做成的. 我参考的网站 http://www.python3.vip/tut/auto/selenium/01/ 准备工作: 1. ...
春运指南之：12306网上订票自动登录下单攻略及相关最新软件
又是一年春运时,在外地打拼奔波的游子们又一次的踏上了回家的旅途,而对于为生活打拼的社会百姓来说,"火车票"三个字承载了太多了希望和心酸.今年购买火车票与往年相比,多了一种方式:网上 ...
华中师范大学CCNU校园网（有线/无线）自动登录程序
写作缘由学校校园网的登录认证的主要方式是连接有线或者无线,之后等系统弹出登录网页,或者你自己上一个网站,会自动跳转到登录界面,在大多数情况下,这没有什么问题,但是在人比较多的时候,比如图书馆,或者信 ...
自动登录AppStore for Mac 1.2
自动登录AppStore for Mac 是 Mac毒发布的一个用来快速登录 Mac App Store 的应用.应用内的默认账号为Mac毒的共享账号,只需点击登录即可自动以共享账号登录商店来下载付费 ...

用VB实现的QQ自动登录器

用VB实现的QQ自动登录器相关推荐

最新文章

热门文章