HOW TO:建立键盘鼠标钩子

Author:水如烟

因为不懂术语,以下只列代码,不作说明:

SafeNativeMethods.vb,要用到的系统函数

Imports System.Runtime.InteropServices
Imports System.Text

Namespace uWindows
    Friend Class SafeNativeMethods
        Sub New()
        End Sub

       '-------------------------------------------
        '鼠标和键盘钩子

        Public Delegate Function HookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer

        '//封送结构
        <StructLayout(LayoutKind.Sequential)> _
        Public Class POINT
            Public x As Integer
            Public y As Integer
        End Class

        <StructLayout(LayoutKind.Sequential)> _
        Public Class MouseHookStruct
            Public pt As POINT
            Public hWnd As Integer
            Public wHitTestCode As Integer
            Public dwExtraInfo As Integer
        End Class

        <StructLayout(LayoutKind.Sequential)> _
        Public Class KeyboardHookStruct
            Public vkCode As Integer '1到254间的虚似键盘码
            Public scanCode As Integer '扫描码
            Public flags As Integer
            Public time As Integer
            Public dwExtraInfo As Integer
        End Class

        <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> _
         Public Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As Integer) As Integer
        End Function
        <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> _
         Public Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
        End Function
        <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> _
         Public Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
        End Function

        <DllImport("user32")> _
        Public Shared Function ToAscii(ByVal uVirtKey As Integer, ByVal uScanCode As Integer, ByVal lpbKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As Integer
        End Function

        <DllImport("user32")> _
        Public Shared Function GetKeyboardState(ByVal pbKeyState As Byte()) As Integer
        End Function

        Public Declare Function GetKeyState Lib "user32" Alias "GetKeyState" (ByVal nVirtKey As Integer) As Integer
    End Class
End Namespace

ConstDefine.vb 系统常量

Namespace uWindows
    Friend Class ConstDefine
        Public Const WM_MOUSEMOVE As Integer = &H200
        Public Const WM_LBUTTONDOWN As Integer = &H201
        Public Const WM_LBUTTONUP As Integer = &H202
        Public Const WM_LBUTTONDBLCLK As Integer = &H203

        Public Const WM_RBUTTONDOWN As Integer = &H204
        Public Const WM_RBUTTONUP As Integer = &H205
        Public Const WM_RBUTTONDBLCLK As Integer = &H206

        Public Const WM_MBUTTONDOWN As Integer = &H207
        Public Const WM_MBUTTONUP As Integer = &H208
        Public Const WM_MBUTTONDBLCLK As Integer = &H209

        Public Const WH_MOUSE_LL As Integer = 14
        Public Const WH_KEYBOARD_LL As Integer = 13

        Public Const WM_KEYDOWN As Integer = &H100
        Public Const WM_KEYUP As Integer = &H101
        Public Const WM_SYSKEYDOWN As Integer = &H104
        Public Const WM_SYSKEYUP As Integer = &H105

    End Class
End Namespace

MouseKeyboardHook.vb 鼠标键盘钩子类

Imports System.Reflection
Imports System.Runtime.InteropServices
Imports LzmTW.uWindows.ConstDefine
Imports LzmTW.uWindows.SafeNativeMethods
Imports System.Windows.Forms

Namespace uWindows

    <ComVisibleAttribute(False), Security.SuppressUnmanagedCodeSecurityAttribute()> _
    Public Class MouseKeyboardHook
        Public Event OnMouseActivity As MouseEventHandler
        Public Event KeyDown As KeyEventHandler
        Public Event KeyPress As KeyPressEventHandler
        Public Event KeyUp As KeyEventHandler

        '//钩子句柄
        Private Shared hMouseHook As Integer = 0
        Private Shared hKeyboardHook As Integer = 0

        Private MouseHookProcedure As HookProc
        Private KeyboardHookProcedure As HookProc
        <Flags()> _
        Enum HookWay
            Mouse = 1 '仅取鼠标消息
            Keyboard = 2 '仅取键盘消息
            All = 3 '两者皆取
        End Enum


        Protected Overrides Sub Finalize()
            Try
                [Stop]()
            Finally
                MyBase.Finalize()
            End Try
        End Sub


        Public Sub Start(ByVal ChooseWay As HookWay)
            If ((hMouseHook = 0) And (ChooseWay And HookWay.Mouse) = HookWay.Mouse) Then
                '//生成一个HookProc的实例
                '//封送结构和Marshal.PtrToStructure、Marshal.GetHINSTANCE是最值得留意的
                MouseHookProcedure = New HookProc(AddressOf Me.MouseHookProc)
                hMouseHook = SetWindowsHookEx( _
                        WH_MOUSE_LL, _
                        MouseHookProcedure, _
                        Marshal.GetHINSTANCE([Assembly].GetExecutingAssembly.GetModules()(0)), _
                        0)
                '//如果安装失败
                If (hMouseHook = 0) Then
                    [Stop]()
                    Throw New Exception("SetWindowsHookEx failed.")
                End If
            End If
            If (hKeyboardHook = 0) Then
                Me.KeyboardHookProcedure = New HookProc(AddressOf KeyboardHookProc)
                hKeyboardHook = SetWindowsHookEx( _
                        WH_KEYBOARD_LL, _
                        KeyboardHookProcedure, _
                        Marshal.GetHINSTANCE([Assembly].GetExecutingAssembly.GetModules()(0)), _
                        0)
                If (hKeyboardHook = 0) Then
                    [Stop]()
                    Throw New Exception("SetWindowsHookEx ist failed.")
                End If
            End If
        End Sub
        Public Sub [Stop]()
            Dim retMouse As Boolean = True
            Dim retKeyboard As Boolean = True
            If hMouseHook <> 0 Then
                retMouse = UnhookWindowsHookEx(hMouseHook)
                hMouseHook = 0
            End If
            If hKeyboardHook <> 0 Then
                retKeyboard = UnhookWindowsHookEx(hKeyboardHook)
                hKeyboardHook = 0
            End If

            '//如果卸下失败
            If Not (retMouse And retKeyboard) Then
                Throw New Exception("UnhookWindowsHookEx failed.")
            End If
        End Sub


        Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
            '//如果正常运行并且用户要监听鼠标的消息
            If nCode >= 0 Then
                Dim button As MouseButtons = MouseButtons.None
                Select Case wParam
                    Case WM_LBUTTONDOWN
                        '//WM_LBUTTONUP
                        '//WM_LBUTTONDBLCLK
                        button = MouseButtons.Left
                    Case WM_RBUTTONDOWN
                        '//WM_RBUTTONUP
                        '//WM_RBUTTONDBLCLK
                        button = MouseButtons.Right
                End Select
                Dim clickCount As Integer = 0
                If Not button = MouseButtons.None Then
                    If wParam = WM_LBUTTONDBLCLK OrElse wParam = WM_RBUTTONDBLCLK Then
                        clickCount = 2
                    Else
                        clickCount = 1
                    End If
                End If
                '//从回调函数中得到鼠标的消息
                Dim MyMouseHookStruct As MouseHookStruct
                MyMouseHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(MouseHookStruct)), MouseHookStruct)
                Dim e As MouseEventArgs = New MouseEventArgs( _
                                                            button, _
                                                            clickCount, _
                                                            MyMouseHookStruct.pt.x, _
                                                            MyMouseHookStruct.pt.y, _
                                                            0)
                RaiseEvent OnMouseActivity(Me, e)
            End If
            Return CallNextHookEx(hMouseHook, nCode, wParam, lParam)
        End Function


        Private Function KeyboardHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
            If nCode >= 0 Then
                Dim MyKeyboardHookStruct As KeyboardHookStruct
                MyKeyboardHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(KeyboardHookStruct)), KeyboardHookStruct)

                '//引发KeyDownEvent
                If wParam = WM_KEYDOWN OrElse wParam = WM_SYSKEYDOWN Then
                    Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
                    Dim e As New KeyEventArgs(keyData)
                    RaiseEvent KeyDown(Me, e)
                End If

                '//引发OnKeyPressEvent
                If wParam = WM_KEYDOWN Then
                    Dim keyState As Byte() = New Byte(256 - 1) {}
                    GetKeyboardState(keyState)
                    Dim inBuffer As Byte() = New Byte(2 - 1) {}
                    If ToAscii( _
                                MyKeyboardHookStruct.vkCode, _
                                MyKeyboardHookStruct.scanCode, _
                                keyState, _
                                inBuffer, _
                                MyKeyboardHookStruct.flags) _
                        = 1 Then
                        Dim e As KeyPressEventArgs = New KeyPressEventArgs(System.Convert.ToChar(inBuffer(0)))
                        RaiseEvent KeyPress(Me, e)
                    End If
                End If

                '//引发OnKeyUpEvent
                If wParam = WM_KEYUP OrElse wParam = WM_SYSKEYUP Then
                    Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
                    Dim e As KeyEventArgs = New KeyEventArgs(keyData)
                    RaiseEvent KeyUp(Me, e)
                End If
            End If
            Return CallNextHookEx(hKeyboardHook, nCode, wParam, lParam)
        End Function
    End Class
End Namespace