VB.net 2010 视频教程 VB.net 2010 视频教程 python基础视频教程
SQL Server 2008 视频教程 c#入门经典教程 Visual Basic从门到精通视频教程
当前位置:
首页 > VB.net教程 >

  • VB.NET全局键盘鼠标钩子 [Vb.Net Hook]（修正版）

原文有些BUG，因为这是段我从C#中转换而来的代码，所在最初的转换中因为两种语言的性质不同，所以无法完全兼容一些特性。 当然，现在的我已经完全有能力兼容两种语言的特性了，所以就重写了本段代码，将原代码中的事件检测，以及原代码中的 KeyPress 时间无法检测输入字符大小写的BUG消除（在此感谢 verywzm 同志）。

注意：本段代码如果想要在VS中运行，请将[工程属性] - [调试] - [启动 Visual Studio 宿主进程] 设置的勾去掉，或者使用 CTRL+F5 进行编译后调试！ 本段代码包含危险代码，请不要用作非法用途！

这是真正的.NET环境下的全局键盘鼠标Hook代码！ 本代码是我从codeproject中翻来的，原作者Michael Kennedy，C#编码。 我将该段C#源码翻译为了VB代码，因为这两种语言的内部机制有一些区别，所以我做了较大的改动。不容易啊~~ 下面的代码是我修改和扩展后的代码，保留所有的权利，翻版不究，盗版可耻。

使用方法很简单，先新建一个类文件，将代码复制进取，然后在一个窗体的空白区域添加一个类型实例。 Dim WithEvents MyHook As New SystemHook() 然后使用静态绑定事件就可以了。 Hook的所有信息已经被封装在了事件的参数中，非常方便哦~

Code ' 非常不容易才翻译过来的。 ' 保留所有权利。

' 夜闻香原创，转载请保留此信息，万分感谢！ ' 博客: http://hi.baidu.com/clso ' 论坛: http://cleclso.cn/

Imports System.Reflection, System.Threading, System.ComponentModel, System.Runtime.InteropServices

/**/''' <summary>本类可以在.NET环境下使用系统键盘与鼠标钩子</summary>
Public Class SystemHookClass SystemHook

定义结构 "定义结构"

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



API声明导入 "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



常量声明#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


事件委托处理#Region "事件委托处理"

Private events As New System.ComponentModel.EventHandlerList

/**/''' <summary>鼠标激活事件</summary>
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
/**/''' <summary>键盘按下事件</summary>
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
/**/''' <summary>键盘输入事件</summary>
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
/**/''' <summary>键盘松开事件</summary>
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



Private hMouseHook As Integer
Private hKeyboardHook As Integer

Private Shared MouseHookProcedure As HookProc
Private Shared KeyboardHookProcedure As HookProc

创建与析构类型 "创建与析构类型"

/**/''' <summary>创建一个全局鼠标键盘钩子 (请使用Start方法开始监视)</summary>
Sub New()Sub New()
    '留空即可
End Sub
/**/''' <summary>创建一个全局鼠标键盘钩子，决定是否安装钩子</summary>
''' <param name="InstallAll">是否立刻挂钩系统消息</param>
Sub New()Sub New(ByVal InstallAll As Boolean)
    If InstallAll Then StartHook(True, True)
End Sub
/**/''' <summary>创建一个全局鼠标键盘钩子，并决定安装钩子的类型</summary>
''' <param name="InstallKeyboard">挂钩键盘消息</param>
''' <param name="InstallMouse">挂钩鼠标消息</param>
Sub New()Sub New(ByVal InstallKeyboard As Boolean, ByVal InstallMouse As Boolean)
    StartHook(InstallKeyboard, InstallMouse)
End Sub
/**/''' <summary>析构函数</summary>
Protected Overrides Sub Finalize()Sub Finalize()
    UnHook() '卸载对象时反注册系统钩子
    MyBase.Finalize()
End Sub



/**/''' <summary>开始安装系统钩子</summary>
''' <param name="InstallKeyboardHook">挂钩键盘消息</param>
''' <param name="InstallMouseHook">挂钩鼠标消息</param>
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
/**/''' <summary>立刻卸载系统钩子</summary>
''' <param name="UninstallKeyboardHook">卸载键盘钩子</param>
''' <param name="UninstallMouseHook">卸载鼠标钩子</param>
''' <param name="ThrowExceptions">是否报告错误</param>
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

/**/''' <summary>键盘钩子是否有效</summary>
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
/**/''' <summary>鼠标钩子是否有效</summary>
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

转载于:https://www.cnblogs.com/clso/archive/2009/04/14/1435299.html



相关教程