LzmTW.uSystem.uWindows.Win32API+MouseKeyboardHook

Author：水如烟  

Imports  System.Reflection
Imports  System.Runtime.InteropServices
Imports  LzmTW.uSystem.uWindows.SafeNative.SafeNativeMethods
Imports  LzmTW.uSystem.uWindows.SafeNative.Constant

Namespace  LzmTW.uSystem.uWindows.Win32API
     < 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