'在VB中建一工程，工程名為QQAutoLogin。移除系統(tǒng)自動(dòng)添加的窗體Form1。在該工程下添加一模塊，模塊名為QQAutoLoginMod。復(fù)制以下代碼到模塊中。
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
'-----------------------結(jié)構(gòu)定義-------------------------------
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號(hào)碼框句柄
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) '根據(jù)窗口句柄獲得擁有窗口的進(jìn)程ID和線程ID
??? hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, nPID) '根據(jù)進(jìn)程ID打開進(jìn)程獲得進(jìn)程句柄
??? strFileName = Space(255)
??? GetModuleFileNameEx hProcess, 0, strFileName, 255 '根據(jù)進(jìn)程句柄獲得進(jìn)程主模塊文件名
??? If Left$(strFileName, InStr(1, strFileName, Chr(0)) - 1) = QQ_ExeFileName Then
??????? If IsWindowVisible(hWnd) Then '整個(gè)QQ.exe登錄期間只有登錄窗口是可見的
??????????? QQ_MainhWnd = hWnd
??????????? QQ_EnumMainhWndProc = False '枚舉函數(shù)返回False結(jié)束循環(huán)枚舉
??????????? 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 '取得窗口客戶區(qū)距形區(qū)域大小
??? nWidth = stRect.Right - stRect.Left
??? nHeight = stRect.Bottom - stRect.Top
???
??? strClassName = Space(255)
??? GetClassName hWnd, strClassName, 255 '根據(jù)窗口句柄獲得窗口類名
??? 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號(hào)碼框被設(shè)計(jì)在一個(gè)ComboBox類的組合框中。
??????????? '父子關(guān)系如下:QQ登錄窗口__ComboBox(父窗口為QQ登錄窗口)__QQ號(hào)碼框(父窗口為ComboBox)
??????????? '這種關(guān)系在QQ登錄窗口中是唯一的，要查找QQ號(hào)碼框要滿足的條件如下:
??????????? '1:類名必須是Edit? 2:父窗口類名必須是ComboBox
??????????? If Left$(strClassName, InStr(1, strClassName, Chr(0)) - 1) = "ComboBox" Then
??????????????? '加多一層檢查,QQ號(hào)碼框的距形大小，這個(gè)也是唯一的。
??????????????? '其實(shí)單單檢查這個(gè)也可以查找到QQ號(hào)碼框
??????????????? '注意這個(gè)會(huì)隨著QQ版本的不同可能會(huì)有所不同，因?yàn)镼Q的界面騰迅一直使其在變(漂亮)
??????????????? 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(對話框)
??????????????? '注意以上兩個(gè)并不是唯一的，必須加多以下一層檢查
??????????????? If nWidth = 131 And nHeight = 14 Then '單單檢查這個(gè)也可以，這個(gè)是唯一的(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??? '外部運(yùn)行QQ.exe
??? Sleep 1000? '延時(shí)1000毫秒
??? QQ_MainhWnd = 0? '初始化登錄窗口句柄
??? Call QQ_GetMainhWnd '獲取QQ登錄窗口句柄(自定義函數(shù))
??? If QQ_MainhWnd Then Debug.Print "成功獲得主窗口句柄"? '調(diào)試語句，可刪除
??? QQ_NumEdithWnd = 0 '初始化號(hào)碼框和密碼框句柄
??? QQ_PwdEdithWnd = 0
??? If QQ_MainhWnd Then Call QQ_GetSubhWnd? '獲取QQ號(hào)碼框和密碼框句柄(自定義函數(shù))
??? If QQ_NumEdithWnd And QQ_PwdEdithWnd Then Debug.Print "成功獲得號(hào)碼框和密碼框句柄"? '調(diào)試語句，可刪除
??? SendMessage QQ_NumEdithWnd, WM_SETTEXT, 0, 0 '清空號(hào)碼框
??? '有人問為什么不用SetFocus直接設(shè)置焦點(diǎn)而用模擬按下Tab鍵，那是因?yàn)镼Q不響應(yīng)獲得焦點(diǎn)消息，調(diào)用SetFocus達(dá)不到效果
??? '還有一個(gè)在QQ登錄窗口Tab鍵只在號(hào)碼框和密碼框之間來回切換，不信你試一下
??? Call SetForegroundWindow(QQ_MainhWnd) '保證模擬鍵盤輸入之前QQ登錄窗口的顯示狀態(tài)
??? If GetFocus() <> QQ_NumEdithWnd Then Call AutoPressKey(vbKeyTab) '保證模擬鍵盤輸入之前焦點(diǎn)在號(hào)碼框
??? Call QQ_AutoPressKey(QQ_NumEdithWnd, strNum) '模擬鍵盤自動(dòng)輸入QQ號(hào)碼
??? Sleep 500
??? If GetFocus() <> QQ_PwdEdithWnd Then Call AutoPressKey(vbKeyTab) '保證模擬鍵盤輸入之前焦點(diǎn)在密碼框
??? Call QQ_AutoPressKey(QQ_PwdEdithWnd, strPwd) '模擬鍵盤自動(dòng)輸入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自動(dòng)登錄函數(shù)(自定義函數(shù))
End Sub

'程序還有以下幾個(gè)致命的缺陷:
'1:如果在該程序運(yùn)行之前已經(jīng)有QQ程序在運(yùn)行(未登錄或已登錄的)，那判斷QQ登錄主窗口的代碼就可能會(huì)不正確了
'2:模擬鍵盤輸入那地方還有點(diǎn)問題,在模擬的中間有可能被別的程序打斷,一失去焦點(diǎn)就亂了

?

總結(jié)

以上是生活随笔為你收集整理的用VB实现的QQ自动登录器的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。