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
