Question

关于VB中定义全局热键

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim DRHwnd As Long
Dim DRPid As Long
Dim DRProcessHandle As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Sub 启动_Click()
DRHwnd = FindWindow("ABCD_CLASS", "abcd")
GetWindowThreadProcessId DRHwnd, DRPid
DRProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, DRPid)
If DRProcessHandle = 0 Then
MsgBox "启动失败", , "S版"
Else
MsgBox "辅助工具"
Timer1.Enabled = True
End If
End Sub

Private Sub 地址写入_Click()
WriteProcessMemory DRProcessHandle, &H5E23E8, &H0, 1, 0&
WriteProcessMemory DRProcessHandle, &H5EE1CEC, &H1, 1, 0&
End Sub
----------------------------
如何在任何窗口下按F2激活窗体代码“地址写入”，我现在只能在窗口中用鼠标点击按钮来激活，麻烦哪位老大帮我补一下代码。
非常感谢！如果是组合键怎么写好？比如Ctrl+D之类的。
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyD) Then
是这样吧？

Answer 1

在窗体上加入控件Timer1(Interval=100),然后复制下面代码，即可实现上述功能：

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '增加的代码
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim DRHwnd As Long
Dim DRPid As Long
Dim DRProcessHandle As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Sub 启动_Click()
DRHwnd = FindWindow("ABCD_CLASS", "abcd")
GetWindowThreadProcessId DRHwnd, DRPid
DRProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, DRPid)
If DRProcessHandle = 0 Then
MsgBox "启动失败", , "S版"
Else
MsgBox "辅助工具"
Timer1.Enabled = True
End If
End Sub

Private Sub 地址写入_Click()
WriteProcessMemory DRProcessHandle, &H5E23E8, &H0, 1, 0&
WriteProcessMemory DRProcessHandle, &H5EE1CEC, &H1, 1, 0&
End Sub

Private Sub Timer1_Timer() '增加的代码
If GetAsyncKeyState(vbKeyF2) Then 地址写入_Click
End Sub

Answer 2

Private Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer

Timer循环检测就行了。。
参数使用VB自带的vbKey系列参数，如vbKeyF2
返回值不为零是说明此键被按下。

Answer 3

窗体代码：
'--------------------------------------------------
Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = (-4)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim DRHwnd As Long
Dim DRPid As Long
Dim DRProcessHandle As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF

Dim nAtom As Long

Private Sub Form_Load(
'将F2注册为系统热键
nAtom = GlobalAddAtom("myProgram")
RegisterHotKey Me.hWnd, nAtom, ByVal 0&, vbKeyF2
lOldProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnregisterHotKey hWnd, nAtom
GlobalDeleteAtom nAtom
SetWindowLong Me.hWnd, GWL_WNDPROC, lOldProc
End Sub

Private Sub 启动_Click()
DRHwnd = FindWindow("ABCD_CLASS", "abcd")
GetWindowThreadProcessId DRHwnd, DRPid
DRProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, DRPid)
If DRProcessHandle = 0 Then
MsgBox "启动失败", , "S版"
Else
MsgBox "辅助工具"
Timer1.Enabled = True
End If
End Sub

Private Sub 地址写入_Click()
WriteProcessMemory DRProcessHandle, &H5E23E8, &H0, 1, 0&
WriteProcessMemory DRProcessHandle, &H5EE1CEC, &H1, 1, 0&
End Sub
'--------------------------------------------------

模块代码：
'--------------------------------------------------
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
Private Const WM_HOTKEY = &H312

Public lOldProc As Long

Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_HOTKEY
If (lParam And &HFFFF0000) / &H10000 = vbKeyF2 Then
call form1.地址写入_Click() '注意将这里Form1改为实际的窗体名称
End If
End Select
WndProc = CallWindowProc(lOldProc, hWnd, Msg, wParam, lParam)
End Function

Answer 4

在窗体上加入一个Timer1控件,Interval为100,然后复制下面代码，即可实现功能：

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim DRHwnd As Long
Dim DRPid As Long
Dim DRProcessHandle As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Sub 启动_Click()
DRHwnd = FindWindow("ABCD_CLASS", "abcd")
GetWindowThreadProcessId DRHwnd, DRPid
DRProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, DRPid)
If DRProcessHandle = 0 Then
MsgBox "启动失败", , "S版"
Else
MsgBox "辅助工具"
Timer1.Enabled = True
End If
End Sub

Private Sub 地址写入_Click()
WriteProcessMemory DRProcessHandle, &H5E23E8, &H0, 1, 0&
WriteProcessMemory DRProcessHandle, &H5EE1CEC, &H1, 1, 0&
End Sub

Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF2) Then 地址写入_Click
End Sub

'end

Answer 5

定义全局热键不用搞这么复杂吧
做一个hook函数 检测到F2就call代码完事了

Answer 6

将注册热键时的Modifiers和uVirtKey1这两个变量赋值为其他值即可。
可以用textbox控件的KeyDown事件获取Keycode值和Shift值，替换uVirtKey1和Modifiers的数值。
值得注意的是KeyDown里的Shift值和Modifiers的值顺序正好相反。
KeyDown里Alt为4，Ctrl为2，Shift为1
而RegisterHotKey里的Modifiers值Alt为1，Ctrl为2，Shift为4。
vbKeyQ其实是一个常数值，它的值就是用KeyDown事件获取的Keycode值。