跑跑卡丁车自动登陆的实现

modAutoLogin.bas

'声明函数
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'定义变量
Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_QUERY_VALUE = &H1

Const BM_CLICK = &HF5
Const WM_SETTEXT = &HC
Const GW_HWNDNEXT = 2

'获得跑跑卡丁车执行文件路径
Private Function GetValue(sValue) As Long
Dim lBuffer As Long, sBuffer As String, hKey As Long, lType As Long
rtn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\TianCity\PopKart\M01", 0, KEY_QUERY_VALUE, hKey)
If rtn <> 0& Then
    GetValue = rtn
    Exit Function
End If

GetValue = RegQueryValueEx(hKey, "Install", 0, lType, ByVal 0, lBuffer)
lBuffer = 255
    sBuffer = Space(lBuffer)
      GetValue = RegQueryValueEx(hKey, "Executable", 0, lType, ByVal sBuffer, lBuffer)
    sValue = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1)
RegCloseKey hKey
End Function

'以下是查找窗口 Button 的代码:
Private Function MyFindWindowDistrict() As Long
    '父窗口类名数组
    Dim A_szClassName(2) As String
    A_szClassName(0) = "SpLoginDialog"
    A_szClassName(1) = "Button"
    '父窗口标题数组
    Dim A_szWinName(2) As String
    A_szWinName(0) = "Login"
    A_szWinName(1) = "电信赛车场(二区)"
    '首先求得顶级父窗口
    Dim hLastWin As Long
    hLastWin = FindWindow(A_szClassName(0), A_szWinName(0))
    '逐次用FindWindowEx函数求出各级子窗口
    For i = 1 To 1
        hLastWin = FindWindowEx(hLastWin, 0, A_szClassName(i), A_szWinName(i))
    Next i
    MyFindWindowDistrict = hLastWin
End Function
'举例: Dim hLastWin as Long
'      hLastWin = MyFindWindow()

'以下是查找窗口 Edit 的代码:
Private Function MyFindWindowEdit() As Long
    '父窗口类名数组
    Dim A_szClassName(2) As String
    A_szClassName(0) = "SpLoginDialog"
    A_szClassName(1) = "Edit"
    '父窗口标题数组
    Dim A_szWinName(2) As String
    A_szWinName(0) = "Login"
    A_szWinName(1) = ""
    '首先求得顶级父窗口
    Dim hLastWin As Long
    hLastWin = FindWindow(A_szClassName(0), A_szWinName(0))
    '逐次用FindWindowEx函数求出各级子窗口
    For i = 1 To 1
        hLastWin = FindWindowEx(hLastWin, 0, A_szClassName(i), A_szWinName(i))
    Next i
    MyFindWindowEdit = hLastWin
End Function
'举例: Dim hLastWinEdit as Long
'      hLastWin = MyFindWindowEdit()

'以下是查找窗口 Button 的代码:
Private Function MyFindWindowButton() As Long
    '父窗口类名数组
    Dim A_szClassName(2) As String
    A_szClassName(0) = "SpLoginDialog"
    A_szClassName(1) = "Button"
    '父窗口标题数组
    Dim A_szWinName(2) As String
    A_szWinName(0) = "Login"
    A_szWinName(1) = "开始"
    '首先求得顶级父窗口
    Dim hLastWin As Long
    hLastWin = FindWindow(A_szClassName(0), A_szWinName(0))
    '逐次用FindWindowEx函数求出各级子窗口
    For i = 1 To 1
        hLastWin = FindWindowEx(hLastWin, 0, A_szClassName(i), A_szWinName(i))
    Next i
    MyFindWindowButton = hLastWin
End Function
'举例: Dim hLastWinButton as Long
'      hLastWin = MyFindWindowButton()

Private Sub Main()
'在紧接着出错语句之后的那条语句处恢复程序执行
On Error Resume Next
    Dim StrMO1Path As String, hLastWinDistrict As Long, hFirstWinEdit As Long
    Dim hLastWinEdit As Long, hLastWinButton As Long, rShell As String
    '运行跑跑卡丁车，判断是否在跑跑卡丁车根目录，然后到注册表中读取
    If Dir("KartRider.exe") = "KartRider.exe" Then
        rShell = Shell("KartRider.exe")
    Else
        '读取跑跑卡丁车执行文件路径
        GetValue StrMO1Path
        rShell = Shell(StrMO1Path, vbNormalFocus)
        If rShell = 0 Then
            MsgBox "无法找到执行文件", vbCritical, "运行出错"
        End
        Exit Sub
        End If
    End If
    '获得按钮语柄
    hLastWinDistrict = MyFindWindowDistrict()
    '进入循环判断
    Do While hLastWinDistrict = 0
    '延迟1秒，因为它太占CPU资源
    Sleep (1000)
    '转让控制权，以便让操作系统处理其它的事件。
    DoEvents
    hLastWinDistrict = MyFindWindowDistrict()
        '获取按钮语柄就退出循环
        If hLastWinDistrict <> 0 Then
            Exit Do
        End If
    '循环结束
    Loop
    '获得按钮语柄
    hLastWinDistrict = MyFindWindowDistrict()
    '向单选按钮发送BM_CLICK消息
    SendMessage hLastWinDistrict, BM_CLICK, 0, 0
    '获得文本框语柄
    hFirstWinEdit = MyFindWindowEdit()
    '设置文本框的值
    SendMessage hFirstWinEdit, WM_SETTEXT, 0, ByVal "帐号"
    '返回下一个窗口的句柄
    hLastWinEdit = GetNextWindow(hFirstWinEdit, 2)
    SendMessage hLastWinEdit, WM_SETTEXT, 0, ByVal "密码"
    hLastWinButton = MyFindWindowButton()
    '向“开始”按钮发送BM_CLICK消息
    SendMessage hLastWinButton, BM_CLICK, 0, 0
    '退出
    End
End Sub