第一次用VB做海贼王游戏按键外挂(暂未完成,菜鸟就是菜鸟)

第一次用VB做海贼王游戏按键外挂(暂未完成,菜鸟就是菜鸟)
2011年12月09日
　　窗体1：
　　Rem 设置登入窗口关闭，后续子窗口也关闭
　　Private Sub Form_Unload(Cancel As Integer)
　　Dim i As Integer
　　On Error Resume Next
　　For i = Forms.Count - 1 To 0 Step -1
　　Unload Forms(i)
　　Next
　　End
　　End Sub
　　Rem 标签单击事件
　　Public Sub Label1_Click()
　　Rem 显示窗体2
　　Form2.Show
　　Rem 窗体2进入游戏官方主页
　　Form2.WebBrowser1.Navigate http://www.opgame.net/main.do?method=doMain
　　Rem 调用模板的闹钟事件
　　ModAPI.Timer1_Timer
　　End Sub
　　窗体2：
　　Rem 从官方网页选择服务器进入游戏
　　Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
　　Cancel = True
　　WebBrowser1.Navigate2 WebBrowser1.Document.activeElement.href
　　End Sub
　　rem 菜单编辑器的开始挂机单击事件
　　Private Sub KS_GJ_Click()
　　KS_GJ.Enabled = False '设置该键被单击，就将启用状态设为false
　　TZGJ.Enabled = True '设置菜单编辑器的停止挂机的启用状态设为true
　　Dim hwnd As Long '设置句柄变量
　　Dim hwnd_1 As RECT '设置窗口结构数据变量
　　hwnd = FindWindow("ThunderFormDC", " ") '查找窗口
　　msgBox "hwnd=" & hwnd ‘调试 实现句柄查找
　　Rem 判断句柄值
　　If hwnd 0 Then
　　Rem 得到窗体的句柄和矩形数据
　　GetWindowRect hwnd, hwnd_1
　　Rem 调试是否得到该窗口数据（已实现）
　　MsgBox "(ck_1.Left)=" & Str(hwnd_1.Left)
　　MsgBox "(ck_1.Top)= " & Str(hwnd_1.Top)
　　MsgBox "(ck_1.Top)= " & Str(hwnd_1.Bottom)
　　MsgBox "(ck_1.Top)= " & Str(hwnd_1.Right)
　　Rem 调用模块的键盘移动方法
　　ModAPI.UpDownMove
　　End If
　　End Sub
　　模块：
　　Rem 查找子窗体函数声明
　　Public 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
　　Rem 键盘事件函数声明
　　Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal
　　wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
　　Rem 查找顶层窗口句柄 函数声明
　　Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,
　　ByVal lpWindowName As String) As Long
　　Rem 获取进程标识
　　Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId
　　As Long) As Long
　　Rem 休眠时间的声明
　　Public Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long)
　　Rem 按键虚拟码的函数声明
　　Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long,
　　ByVal wMapType As Long) As Long
　　Rem 键盘事件过程声明
　　Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags
　　As Long, ByValdwExtraInfo As Long)
　　rem 获得窗体数据的函数声明
　　Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
　　Public Type RECT
　　Left As Long
　　Top As Long
　　Right As Long
　　Bottom As Long
　　End Type
　　Rem 常数声明
　　Public Const WM_KEYDOWN = &H100
　　Public Const WM_KEYUP = &H101
　　Rem 设置窗体2的时钟Timer事件
　　Public Sub Timer1_Timer()
　　rem 定义句柄变量
　　Dim hwnd As Long
　　rem 查找句柄值
　　hwnd = FindWindow("ThunderFormDC", "")
　　Rem 调试 句柄值调试为实现，运行却为0；
　　MsgBox "hwnd=" & hwnd
　　rem 设置窗体1的标签启用状态
　　If hwnd = 0 Then
　　Form1.Label1.Enabled = False
　　Else
　　Form1.Label1.Enabled = True
　　End If
　　End Sub
　　Rem 设置键盘虚拟码函数
　　Public Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
　　Dim s As String
　　Dim Firstbyte As String
　　If flag = WM_KEYDOWN Then
　　Firstbyte = "00"
　　Else
　　Firstbyte = "C0"
　　End If
　　Dim Scancode As Long
　　Scancode = MapVirtualKey(VirtualKey, 0)
　　Dim Secondbyte As String 'lparam
　　Secondbyte = Right("00" & Hex(Scancode), 2)
　　s = Firstbyte & Secondbyte & "0001"
　　MakeKeyLparam = Val("&H" & s)
　　End Function
　　Rem 键盘移动事件
　　Public Sub UpDownMove( )
　　设置窗口句柄变量
　　Dim hWnd1 As Long
　　Dim hWnd2 As Long
　　'获得顶层窗口句柄
　　hWnd1 = FindWindow("ThunderFormDC", " ")
　　'获得子窗口句柄 获取窗口句柄失败
　　hWnd2 = FindWindowEx(hWnd1, 0, "MacromediaFlashPlayerActiveXr", " ")
　　’直接用hwnd2变量 赋值 作为窗口顶层查找？？？？？？？？失败
　　'hWnd2 = FindWindow("MacromediaFlashPlayerActiveXr", vbNullString)
　　Rem 两个句柄值的调试，hwnd1实现句柄，
　　MsgBox "hwnd1=" & hWnd1
　　MsgBox "hwnd2=" & hWnd2
　　键盘的向下移动事件： 在窗体2调用没有反应？
　　'Sleep 2000
　　'PostMessage hWnd2, WM_KEYDOWN, vbKeyDown, MakeKeyLparam(vbKeyDown, WM_KEYDOWN)
　　' Sleep 500
　　'PostMessage hwnd2, WM_KEYUP, vbKeyDown, MakeKeyLparam(vbKeyDown, WM_KEYUP)
　　'Sleep 3000
　　'PostMessage hwnd2, WM_KEYDOWN, vbKeyDown, MakeKeyLparam(vbKeyDown, WM_KEYDOWN)
　　'Sleep 1000
　　'PostMessage hwnd2, WM_KEYUP, vbKeyDown, MakeKeyLparam(vbKeyDown, WM_KEYUP)
　　End Sub