求一个VB.net可用的线程键盘钩子,用API的,不要全局钩子,不要利用窗体响应事件
9条回答 默认 最新
- soar3033 2022-03-28 12:54关注
获得15.60元问题酬金 Imports System.Reflection, System.Threading, System.ComponentModel, System.Runtime.InteropServices /**/''' 本类可以在.NET 环境下使用系统键盘与鼠标钩子 Public Class SystemHookClass SystemHook 定义结构#Region " 定义结构" Private Structure MouseHookStructStructure MouseHookStruct Dim PT As POINT Dim Hwnd As Integer Dim WHitTestCode As Integer Dim DwExtraInfo As Integer End Structure Private Structure MouseLLHookStructStructure MouseLLHookStruct Dim PT As POINT Dim MouseData As Integer Dim Flags As Integer Dim Time As Integer Dim DwExtraInfo As Integer End Structure Private Structure KeyboardHookStructStructure KeyboardHookStruct Dim vkCode As Integer Dim ScanCode As Integer Dim Flags As Integer Dim Time As Integer Dim DwExtraInfo As Integer End Structure #End Region API 声明导入#Region "API 声明导入" Private Declare Function SetWindowsHookEx()Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As HookProc, ByVal hMod As IntPtr, ByVal dwThreadId As Integer) As Integer Private Declare Function UnhookWindowsHookEx()Function UnhookWindowsHookEx Lib "user32" (ByVal idHook As Integer) As Integer Private Declare Function CallNextHookEx()Function CallNextHookEx Lib "user32" (ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer Private Declare Function ToAscii()Function ToAscii Lib "user32" (ByVal uVirtKey As Integer, ByVal uScancode As Integer, ByVal lpdKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As Integer Private Declare Function GetKeyboardState()Function GetKeyboardState Lib "user32" (ByVal pbKeyState As Byte()) As Integer Private Declare Function GetKeyState()Function GetKeyState Lib "user32" (ByVal vKey As Integer) As Short Private Delegate Function HookProc()Function HookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer #End Region 常量声明#Region " 常量声明" Private Const WH_MOUSE_LL = 14 Private Const WH_KEYBOARD_LL = 13 Private Const WH_MOUSE = 7 Private Const WH_KEYBOARD = 2 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_MBUTTONDOWN = &H207 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONUP = &H205 Private Const WM_MBUTTONUP = &H208 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MOUSEWHEEL = &H20A Private Const WM_KEYDOWN = &H100 Private Const WM_KEYUP = &H101 Private Const WM_SYSKEYDOWN = &H104 Private Const WM_SYSKEYUP = &H105 Private Const VK_SHIFT As Byte = &H10 Private Const VK_CAPITAL As Byte = &H14 Private Const VK_NUMLOCK As Byte = &H90 #End Region 事件委托处理#Region " 事件委托处理" Private events As New System.ComponentModel.EventHandlerList /**/''' 鼠标激活事件 Public Custom Event MouseActivity As MouseEventHandler AddHandler(ByVal value As MouseEventHandler) events.AddHandler("MouseActivity", value) End AddHandler RemoveHandler(ByVal value As MouseEventHandler) events.RemoveHandler("MouseActivity", value) End RemoveHandler RaiseEvent(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim eh As MouseEventHandler = TryCast(events("MouseActivity"), MouseEventHandler) If eh IsNot Nothing Then eh.Invoke(sender, e) End RaiseEvent End Event /**/''' 键盘按下事件 Public Custom Event KeyDown As KeyEventHandler AddHandler(ByVal value As KeyEventHandler) events.AddHandler("KeyDown", value) End AddHandler RemoveHandler(ByVal value As KeyEventHandler) events.RemoveHandler("KeyDown", value) End RemoveHandler RaiseEvent(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Dim eh As KeyEventHandler = TryCast(events("KeyDown"), KeyEventHandler) If eh IsNot Nothing Then eh.Invoke(sender, e) End RaiseEvent End Event /**/''' 键盘输入事件 Public Custom Event KeyPress As KeyPressEventHandler AddHandler(ByVal value As KeyPressEventHandler) events.AddHandler("KeyPress", value) End AddHandler RemoveHandler(ByVal value As KeyPressEventHandler) events.RemoveHandler("KeyPress", value) End RemoveHandler RaiseEvent(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Dim eh As KeyPressEventHandler = TryCast(events("KeyPress"), KeyPressEventHandler) If eh IsNot Nothing Then eh.Invoke(sender, e) End RaiseEvent End Event /**/''' 键盘松开事件 Public Custom Event KeyUp As KeyEventHandler AddHandler(ByVal value As KeyEventHandler) events.AddHandler("KeyUp", value) End AddHandler RemoveHandler(ByVal value As KeyEventHandler) events.RemoveHandler("KeyUp", value) End RemoveHandler RaiseEvent(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Dim eh As KeyEventHandler = TryCast(events("KeyUp"), KeyEventHandler) If eh IsNot Nothing Then eh.Invoke(sender, e) End RaiseEvent End Event #End Region Private hMouseHook As Integer Private hKeyboardHook As Integer Private Shared MouseHookProcedure As HookProc Private Shared KeyboardHookProcedure As HookProc 创建与析构类型#Region " 创建与析构类型" /**/''' 创建一个全局鼠标键盘钩子 ( 请使用Start 方法开始监视) Sub New()Sub New() ' 留空即可 End Sub /**/''' 创建一个全局鼠标键盘钩子,决定是否安装钩子 ''' 是否立刻挂钩系统消息 Sub New()Sub New(ByVal InstallAll As Boolean) If InstallAll Then StartHook(True, True) End Sub /**/''' 创建一个全局鼠标键盘钩子,并决定安装钩子的类型 ''' 挂钩键盘消息 ''' 挂钩鼠标消息 Sub New()Sub New(ByVal InstallKeyboard As Boolean, ByVal InstallMouse As Boolean) StartHook(InstallKeyboard, InstallMouse) End Sub /**/''' 析构函数 Protected Overrides Sub Finalize()Sub Finalize() UnHook() ' 卸载对象时反注册系统钩子 MyBase.Finalize() End Sub #End Region /**/''' 开始安装系统钩子 ''' 挂钩键盘消息 ''' 挂钩鼠标消息 Public Sub StartHook()Sub StartHook(Optional ByVal InstallKeyboardHook As Boolean = True, Optional ByVal InstallMouseHook As Boolean = False) ' 注册键盘钩子 If InstallKeyboardHook AndAlso hKeyboardHook = 0 Then KeyboardHookProcedure = New HookProc(AddressOf KeyboardHookProc) hKeyboardHook = SetWindowsHookEx(WH_KEYBOARD_LL, KeyboardHookProcedure, Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)), 0) If hKeyboardHook = 0 Then ' 检测是否注册完成 UnHook(True, False) ' 在这里反注册 Throw New Win32Exception(Marshal.GetLastWin32Error) ' 报告错误 End If End If ' 注册鼠标钩子 If InstallMouseHook AndAlso hMouseHook = 0 Then MouseHookProcedure = New HookProc(AddressOf MouseHookProc) hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, MouseHookProcedure, Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)), 0) If hMouseHook = 0 Then UnHook(False, True) Throw New Win32Exception(Marshal.GetLastWin32Error) End If End If End Sub /**/''' 立刻卸载系统钩子 ''' 卸载键盘钩子 ''' 卸载鼠标钩子 ''' 是否报告错误 Public Sub UnHook()Sub UnHook(Optional ByVal UninstallKeyboardHook As Boolean = True, Optional ByVal UninstallMouseHook As Boolean = True, Optional ByVal ThrowExceptions As Boolean = False) ' 卸载键盘钩子 If hKeyboardHook <> 0 AndAlso UninstallKeyboardHook Then Dim retKeyboard As Integer = UnhookWindowsHookEx(hKeyboardHook) hKeyboardHook = 0 If ThrowExceptions AndAlso retKeyboard = 0 Then ' 如果出现错误,是否报告错误 Throw New Win32Exception(Marshal.GetLastWin32Error) ' 报告错误 End If End If ' 卸载鼠标钩子 If hMouseHook <> 0 AndAlso UninstallMouseHook Then Dim retMouse As Integer = UnhookWindowsHookEx(hMouseHook) hMouseHook = 0 If ThrowExceptions AndAlso retMouse = 0 Then Throw New Win32Exception(Marshal.GetLastWin32Error) End If End If End Sub ' 键盘消息的委托处理代码 Private Function KeyboardHookProc()Function KeyboardHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer Static handled As Boolean : handled = False If nCode >= 0 AndAlso (events("KeyDown") IsNot Nothing OrElse events("KeyPress") IsNot Nothing OrElse events("KeyUp") IsNot Nothing) Then Static MyKeyboardHookStruct As KeyboardHookStruct MyKeyboardHookStruct = DirectCast(Marshal.PtrToStructure(lParam, GetType(KeyboardHookStruct)), KeyboardHookStruct) ' 激活KeyDown If wParam = WM_KEYDOWN OrElse wParam = WM_SYSKEYDOWN Then ' 如果消息为按下普通键或系统键 Dim e As New KeyEventArgs(MyKeyboardHookStruct.vkCode) RaiseEvent KeyDown(Me, e) ' 激活事件 handled = handled Or e.Handled ' 是否取消下一个钩子 End If ' 激活KeyUp If wParam = WM_KEYUP OrElse wParam = WM_SYSKEYUP Then Dim e As New KeyEventArgs(MyKeyboardHookStruct.vkCode) RaiseEvent KeyUp(Me, e) handled = handled Or e.Handled End If ' 激活KeyPress (TODO: 此段代码还有BUG !) If wParam = WM_KEYDOWN Then Dim isDownShift As Boolean = (GetKeyState(VK_SHIFT) & &H80 = &H80) Dim isDownCapslock As Boolean = (GetKeyState(VK_CAPITAL) <> 0) Dim keyState(256) As Byte GetKeyboardState(keyState) Dim inBuffer(2) As Byte If ToAscii(MyKeyboardHookStruct.vkCode, MyKeyboardHookStruct.ScanCode, keyState, inBuffer, MyKeyboardHookStruct.Flags) = 1 Then Static key As Char : key = Chr(inBuffer(0)) ' BUG 所在 'If isDownCapslock Xor isDownShift And Char.IsLetter(key) Then ' key = Char.ToUpper(key) 'End If Dim e As New KeyPressEventArgs(key) RaiseEvent KeyPress(Me, e) handled = handled Or e.Handled End If End If ' 取消或者激活下一个钩子 If handled Then Return 1 Else Return CallNextHookEx(hKeyboardHook, nCode, wParam, lParam) End If End Function ' 鼠标消息的委托处理代码 Private Function MouseHookProc()Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer If nCode >= 0 AndAlso events("MouseActivity") IsNot Nothing Then Static mouseHookStruct As MouseLLHookStruct mouseHookStruct = DirectCast(Marshal.PtrToStructure(lParam, GetType(MouseLLHookStruct)), MouseLLHookStruct) Static moubut As MouseButtons : moubut = MouseButtons.None ' 鼠标按键 Static mouseDelta As Integer : mouseDelta = 0 ' 滚轮值 Select Case wParam Case WM_LBUTTONDOWN moubut = MouseButtons.Left Case WM_RBUTTONDOWN moubut = MouseButtons.Right Case WM_MBUTTONDOWN moubut = MouseButtons.Middle Case WM_MOUSEWHEEL Static int As Integer : int = (mouseHookStruct.MouseData >> 16) And &HFFFF ' 本段代码CLE 添加,模仿C# 的Short 从Int 弃位转换 If int > Short.MaxValue Then mouseDelta = int - 65536 Else mouseDelta = int End Select Static clickCount As Integer : clickCount = 0 ' 单击次数 If moubut <> MouseButtons.None Then If wParam = WM_LBUTTONDBLCLK OrElse wParam = WM_RBUTTONDBLCLK OrElse wParam = WM_MBUTTONDBLCLK Then clickCount = 2 Else clickCount = 1 End If End If Dim e As New MouseEventArgs(moubut, clickCount, mouseHookStruct.PT.X, mouseHookStruct.PT.Y, mouseDelta) RaiseEvent MouseActivity(Me, e) End If Return CallNextHookEx(hMouseHook, nCode, wParam, lParam) ' 激活下一个钩子 End Function /**/''' 键盘钩子是否有效 Public Property KeyHookEnabled()Property KeyHookEnabled() As Boolean Get Return hKeyboardHook <> 0 End Get Set(ByVal value As Boolean) If value Then StartHook(True, False) Else UnHook(True, False) End Set End Property /**/''' 鼠标钩子是否有效 Public Property MouseHookEnabled()Property MouseHookEnabled() As Boolean Get Return hMouseHook <> 0 End Get Set(ByVal value As Boolean) If value Then StartHook(False, True) Else UnHook(False, True) End Set End Property End Class
解决 3无用 1
悬赏问题
- ¥30 seata使用出现报错,其他服务找不到seata
- ¥15 怎么实现输入一个要删除的数后删除后显示剩余数再输入再删除显示剩余数(语言-c语言)
- ¥35 引用csv数据文件(4列1800行),通过高斯-赛德尔法拟合曲线,在选取(每五十点取1点)数据,求该数据点的曲率中心。
- ¥20 程序只发送0X01,串口助手显示不正确,配置看了没有问题115200-8-1-no,如何解决?
- ¥15 Google speech command 数据集获取
- ¥15 vue3+element-plus页面崩溃
- ¥15 像这种代码要怎么跑起来?
- ¥15 安卓C读取/dev/fastpipe屏幕像素数据
- ¥15 pyqt5tools安装失败
- ¥15 mmdetection