VB.NET全局鍵盤鼠標鉤子 [Vb.Net Hook](修正版)


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的所有信息已經被封裝在了事件的參數中,非常方便哦~


' 非常不容易才翻譯過來的。
'
 保留所有權利。

' 夜聞香原創,轉載請保留此信息,萬分感謝!
'
 博客: http://hi.baidu.com/clso
'
 論壇: http://cleclso.cn/
'
 QQ:315514678 E-mail:clso@qq.com
'
 歡迎技術交流!


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

''' <summary>本類可以在.NET環境下使用系統鍵盤與鼠標鉤子</summary>
Public Class SystemHook

#Region "定義結構"

    
Private Structure MouseHookStruct
        
Dim PT As POINT
        
Dim Hwnd As Integer
        
Dim WHitTestCode As Integer
        
Dim DwExtraInfo As Integer
    
End Structure


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


#Region "API聲明導入"

    
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As IntegerByVal lpfn As HookProc, ByVal hMod As IntPtr, ByVal dwThreadId As IntegerAs Integer
    
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal idHook As IntegerAs Integer
    
Private Declare Function CallNextHookEx Lib "user32" (ByVal idHook As IntegerByVal nCode As IntegerByVal wParam As IntegerByVal lParam As IntPtr) As Integer
    
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As IntegerByVal uScancode As IntegerByVal lpdKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As IntegerAs Integer
    
Private Declare Function GetKeyboardState Lib "user32" (ByVal pbKeyState As Byte()) As Integer
    
Private Declare Function GetKeyState Lib "user32" (ByVal vKey As IntegerAs Short

    
Private Delegate Function HookProc(ByVal nCode As IntegerByVal wParam As IntegerByVal 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

    
''' <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 ObjectByVal 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 ObjectByVal 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 ObjectByVal 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 ObjectByVal 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 "創建與析構類型"

    
''' <summary>創建一個全局鼠標鍵盤鉤子 (請使用Start方法開始監視)</summary>
    Sub New()
        
'留空即可
    End Sub

    
''' <summary>創建一個全局鼠標鍵盤鉤子,決定是否安裝鉤子</summary>
    
''' <param name="InstallAll">是否立刻掛鉤系統消息</param>

    Sub New(ByVal InstallAll As Boolean)
        
If InstallAll Then StartHook(TrueTrue)
    
End Sub

    
''' <summary>創建一個全局鼠標鍵盤鉤子,並決定安裝鉤子的類型</summary>
    
''' <param name="InstallKeyboard">掛鉤鍵盤消息</param>
    
''' <param name="InstallMouse">掛鉤鼠標消息</param>

    Sub New(ByVal InstallKeyboard As BooleanByVal InstallMouse As Boolean)
        StartHook(InstallKeyboard, InstallMouse)
    
End Sub

    
''' <summary>析構函數</summary>
    Protected Overrides Sub Finalize()
        UnHook() 
'卸載對象時反註冊系統鉤子
        MyBase.Finalize()
    
End Sub


#End Region


    
''' <summary>開始安裝系統鉤子</summary>
    
''' <param name="InstallKeyboardHook">掛鉤鍵盤消息</param>
    
''' <param name="InstallMouseHook">掛鉤鼠標消息</param>

    Public Sub StartHook(Optional ByVal InstallKeyboardHook As Boolean = TrueOptional 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(TrueFalse'在這裡反註冊
                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(
FalseTrue)
                
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(Optional ByVal UninstallKeyboardHook As Boolean = TrueOptional ByVal UninstallMouseHook As Boolean = TrueOptional 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(ByVal nCode As IntegerByVal wParam As IntegerByVal 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 NothingThen
            
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(256As Byte
                GetKeyboardState(keyState)
                
Dim inBuffer(2As 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(ByVal nCode As IntegerByVal wParam As IntegerByVal 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 >> 16And &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() As Boolean
        
Get
            
Return hKeyboardHook <> 0
        
End Get
        
Set(ByVal value As Boolean)
            
If value Then StartHook(TrueFalseElse UnHook(TrueFalse)
        
End Set
    
End Property

    
''' <summary>鼠標鉤子是否有效</summary>
    Public Property MouseHookEnabled() As Boolean
        
Get
            
Return hMouseHook <> 0
        
End Get
        
Set(ByVal value As Boolean)
            
If value Then StartHook(FalseTrueElse UnHook(FalseTrue)
        
End Set
    
End Property


End Class



工程下載: 已失效...

留言

張貼留言

本月最夯

偷用電腦,怎知?事件檢視器全記錄!(開機時間、啟動項時間...)