键盘勾子

Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400

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
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function SetKeyboardHook Lib "KeybHook" (ByVal hwndPost As Long, ByVal Msg As Long) As Long
Declare Function ReleaseKeyboardHook Lib "KeybHook" () As Long

Public prevWndProc As Long

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_USER Then
        Form1.List1.AddItem "wParam=" & wParam & ", lParam=" & Hex(lParam)
        Form1.List1.ListIndex = Form1.List1.NewIndex
    End If
    WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function


Option Explicit

Private Sub Form_Load()
    On Error Resume Next

    SetKeyboardHook Me.hWnd, WM_USER

    If Err.Number <> 0 Then
        MsgBox "请先将 KeybHook.dll 复制到 Windows 的所在路径!", vbCritical
        End
    End If
    On Error GoTo 0
   
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ReleaseKeyboardHook
   
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub