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