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
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
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