用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:模拟键盘输入那地方还有点问题,在模拟的中间有可能被别的程序打断,一失去焦点就乱了

转载于:https://www.cnblogs.com/ZYM/archive/2008/04/14/1151944.html