键盘勾子

最新推荐文章于 2024-10-18 16:37:05 发布

eastsir

最新推荐文章于 2024-10-18 16:37:05 发布

阅读量458

点赞数

文章标签： function user integer windows hex

本文链接：https://blog.csdn.net/eastsir/article/details/1317912

版权

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