自己本来想做个海贼王游戏按键模拟挂,又碰到难题了,希望路过的高手的帮忙看看(因为有点乱,不过加了注释了。
可以的话也帮忙指点下,本人实属菜菜鸟级,这里先谢谢了)
窗体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
Rem
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实现句柄,(???????hwnd2怎么弄都是=0??????要怎么才能得到hwnd2的句柄哦)
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 全部代码是可以运行的:键盘的向下移动事件: 在窗体2调用没有反应?hWnd2窗口测试一直都为0;
怎么才能找到它的值呢? 或者直接能在游戏里实现键盘事件呢?
代码有点小长,麻烦各位了,谢谢!
可以的话也帮忙指点下,本人实属菜菜鸟级,这里先谢谢了)
窗体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
Rem
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实现句柄,(???????hwnd2怎么弄都是=0??????要怎么才能得到hwnd2的句柄哦)
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 全部代码是可以运行的:键盘的向下移动事件: 在窗体2调用没有反应?hWnd2窗口测试一直都为0;
怎么才能找到它的值呢? 或者直接能在游戏里实现键盘事件呢?
代码有点小长,麻烦各位了,谢谢!
解决方案 »
- VB6.0 类listItem和控件listView 的使用问题
- 打印机一次打印一行代码如何实现。
- VB打开TXT文件的问题? 急!!!
- 我来提个问题吧,VB如何编写一个将图像生成缩略图、添加水印的组件!
- ▁▂▃▄▅▆▇█▉谁会用VB6??大跌眼镜!这个Visual Component Manager 居然找不到在哪里?!怎么使用啊?!█▇▆▅▄▃▂▁
- VB 找出excel文件里合并的单元格
- 相当程序员非要大学毕业?
- 例子代码:不用循环,同过.Text获取.ListIndex(ComboBox,ListBox)
- 千山万水总是情,给我个正确答案行不行?
- vb引用excel 自动化错误-2147024156(800702e4)
- acer这个电脑怎么样??
- WINSOCK文件传输
用该方法可能是因为网页在VB窗体内,所以两个句柄值都为0
Dim hwnd As Long
Dim hwnd_1 As Long
hwnd_1 = FindWindow("Internet Explorer_Server' vbNullString)
hwnd = GetWindow(hwnd_1, GW_HWNDNEXT"
MsgBox "hwnd_1= " & hwnd_1
MsgBox "hwnd= " & hwnd 如果改用在VB窗体的类(窗体2登入游戏窗体类ThunderFormDC)上查找,却找到的hwnd值为窗体1
Dim hwnd As Long
Dim hwnd_1 As Long
hwnd_1 = FindWindow("ThunderFormDC",vbNullString)
hwnd = GetWindow(hwnd_1, GW_HWNDNEXT"
MsgBox "hwnd_1= " & hwnd_1
MsgBox "hwnd= " & hwnd
这句柄怎么会找不到.........
希望高手帮忙解决下,谢谢............
'Api声明
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'系统参数宏
Public Const GW_CHILD As Long = 5
Public Const GW_HWNDNEXT As Long = 2
Public Const GWL_WNDPROC As Long = -4
Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206
'个人参数设定
Dim lpPrevWndFunc As Long
'--------------------------------------------------------- '查webbrowser的hwnd
Dim hwnd As Long
hwnd = FindWebPage(frmExam.hwnd)
'---找窗口中的Webbrowser的句柄-------------------------------------------
Public Function FindWebPage(ByVal hParentWnd As Long) As Long Dim strClassName As String * 30
Dim hTempWnd As Long
hTempWnd = GetWindow(hParentWnd, GW_CHILD)
Do While (hTempWnd <> 0)
strClassName = ""
GetClassName hTempWnd, strClassName, 30
Debug.Print strClassName
If Left(strClassName, Len("Internet Explorer_Server")) = "Internet Explorer_Server" Then
'找到则
WebhWnd = hTempWnd
FindWebPage = WebhWnd
Exit Function
End If
'没找到,继续找下一个节点
FindWebPage = FindWebPage(hTempWnd)
If FindWebPage <> 0 Then
Exit Function
End If
hTempWnd = GetWindow(hTempWnd, GW_HWNDNEXT)
Loop
End Function
VB code(frmExam.hwnd)
FindWebPage = WebhWnd
这些函数 都没有定义 不懂怎么弄
这个代码不完整啊.....
'传入参数是包含有webbrowser控件的窗口的hwnd值,函数返回值就是webbrowser的hwnd值了。
hwnd = FindWebPage(Form.hwnd)