关于VB中键盘钩子的使用说明,该怎么处理
关于VB中键盘钩子的使用说明
已经成功地安装钩子并截获到了按键消息,并得知wParam是按键的虚拟键码,但是lParam如何使用,怎样判断组合键?具体是什么意思。谢谢。另外,低级键盘钩子的这两个参数又是什么意思?
------解决方案--------------------
这是我以前找到的自己修改后键盘HOOK完整的例子,你可以自己研究一下。
modHook.bas
Option Explicit
Public Declare Function CallNextHookEx Lib "user32.dll " (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32 " Alias "RtlMoveMemory " (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Sub keybd_event Lib "user32 " (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Datas() As String
Public NUM As Long
Public OldHook As Long
Public LngClsPtr As Long
Public Function BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Exit Function
End If
ResolvePointer(LngClsPtr).RiseEvent (lparam)
Call CallNextHookEx(OldHook, nCode, wParam, lparam)
End Function
Private Function ResolvePointer(ByVal lpObj As Long) As ClsHook
Dim oSH As ClsHook
CopyMemory oSH, lpObj, 4&
Set ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
End Function
ClsHook.cls
Option Explicit
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Private Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Private Const WH_JOURNALRECORD = 0
Private Const WM_KEYDOWN = &H100
Private Declare Function SetWindowsHookEx Lib "user32.dll " Alias "SetWindowsHookExA " (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll " (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32.dll " (ByVal vKey As Long) As Integer
Public Sub SetHook()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
End Sub
Public Sub UnHook()
Call UnhookWindowsHookEx(OldHook)
End Sub
Friend Function RiseEvent(ByVal lparam As Long) As Long
Dim Msg As EVENTMSG
Dim IntShift As Integer
Dim IntCode As Integer
CopyMemory Msg, ByVal lparam, Len(Msg)
IntShift = 0
Select Case Msg.wMsg
Case WM_KEYDOWN
If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)
If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)
If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)
IntCode = Msg.lParamLow And &HFF
Debug.Print Msg.lParamLow
Debug.Print &HFF
RaiseEvent KeyDown(IntCode, IntShift)
End Select
End Function
Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
End Sub
form1.frm
Option Explicit
Dim WithEvents Hook As ClsHook
Private Declare Function MapVirtualKeyEx Lib "user32 " Alias "MapVirtualKeyExA " (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32 " (ByVal dwLayout As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32 " () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal hwnd As Long, lpdwProcessId As Long) As Long
已经成功地安装钩子并截获到了按键消息,并得知wParam是按键的虚拟键码,但是lParam如何使用,怎样判断组合键?具体是什么意思。谢谢。另外,低级键盘钩子的这两个参数又是什么意思?
------解决方案--------------------
这是我以前找到的自己修改后键盘HOOK完整的例子,你可以自己研究一下。
modHook.bas
Option Explicit
Public Declare Function CallNextHookEx Lib "user32.dll " (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32 " Alias "RtlMoveMemory " (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Sub keybd_event Lib "user32 " (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Datas() As String
Public NUM As Long
Public OldHook As Long
Public LngClsPtr As Long
Public Function BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Exit Function
End If
ResolvePointer(LngClsPtr).RiseEvent (lparam)
Call CallNextHookEx(OldHook, nCode, wParam, lparam)
End Function
Private Function ResolvePointer(ByVal lpObj As Long) As ClsHook
Dim oSH As ClsHook
CopyMemory oSH, lpObj, 4&
Set ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
End Function
ClsHook.cls
Option Explicit
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Private Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Private Const WH_JOURNALRECORD = 0
Private Const WM_KEYDOWN = &H100
Private Declare Function SetWindowsHookEx Lib "user32.dll " Alias "SetWindowsHookExA " (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll " (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32.dll " (ByVal vKey As Long) As Integer
Public Sub SetHook()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
End Sub
Public Sub UnHook()
Call UnhookWindowsHookEx(OldHook)
End Sub
Friend Function RiseEvent(ByVal lparam As Long) As Long
Dim Msg As EVENTMSG
Dim IntShift As Integer
Dim IntCode As Integer
CopyMemory Msg, ByVal lparam, Len(Msg)
IntShift = 0
Select Case Msg.wMsg
Case WM_KEYDOWN
If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)
If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)
If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)
IntCode = Msg.lParamLow And &HFF
Debug.Print Msg.lParamLow
Debug.Print &HFF
RaiseEvent KeyDown(IntCode, IntShift)
End Select
End Function
Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
End Sub
form1.frm
Option Explicit
Dim WithEvents Hook As ClsHook
Private Declare Function MapVirtualKeyEx Lib "user32 " Alias "MapVirtualKeyExA " (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32 " (ByVal dwLayout As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32 " () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal hwnd As Long, lpdwProcessId As Long) As Long