用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:模擬鍵盤輸入那地方還有點問題,在模擬的中間有可能被別的程序打斷,一失去焦點就亂了