在.net里使用全局钩子的代码

要在.net的环境里使用全局钩子,http://www.codeproject.com/csharp/globalhook.asp?df=100&forumid=57596&select=1047065#xx1047065xx 是一篇好文章,提供的代码也相当可用了

我把他转成了VB.net并fix了一些小bug,贴在这里。
调用方法:

Private actHook As UserActivityHook


actHook = New UserActivityHook()

AddHandler actHook.OnMouseActivity, AddressOf myMouseEventHandler

AddHandler actHook.KeyDown, AddressOf myKeyEventHandler



Imports System
Imports System.Runtime.InteropServices
Imports System.Reflection
Imports System.Threading
Imports System.Windows.Forms

Public Class UserActivityHook
    
Inherits Object

    
Public Sub New()
        Start()
    
End Sub


    
Protected Overrides Sub Finalize()
        StopMe()
    
End Sub


    
Public Event OnMouseActivity As MouseEventHandler
    
Public Event KeyDown As KeyEventHandler
    
Public Event KeyPress As KeyPressEventHandler
    
Public Event KeyUp As KeyEventHandler

    
Public Delegate Function HookProc(ByVal nCode As IntegerByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
    
Shared hMouseHook As Integer = 0
    
Shared hKeyboardHook As Integer = 0
    
Public Const WH_MOUSE_LL As Integer = 14
    
Public Const WH_KEYBOARD_LL As Integer = 13
    
Private MouseHookProcedure As HookProc
    
Private KeyboardHookProcedure As HookProc

    
<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
        
Public scanCode As Integer
        
Public flags As Integer
        
Public time As Integer
        
Public dwExtraInfo As Integer
    
End Class


    
Declare Auto Function SetWindowsHookEx Lib "user32.dll" (ByVal idHook As IntegerByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As IntegerAs Integer

    
Declare Auto Function UnhookWindowsHookEx Lib "user32.dll" (ByVal idHook As IntegerAs Boolean

    
Declare Auto Function CallNextHookEx Lib "user32.dll" (ByVal idHook As IntegerByVal nCode As IntegerByVal wParam As Int32, ByVal lParam As IntPtr) As Integer

    
Public Sub Start()
        
If hMouseHook = 0 Then
            MouseHookProcedure 
= AddressOf MouseHookProc
            hMouseHook 
= SetWindowsHookEx(WH_MOUSE_LL, MouseHookProcedure, Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)), 0)
            
If hMouseHook = 0 Then
                StopMe()
                
Throw New Exception("SetWindowsHookEx failed.")
            
End If
        
End If
        
If hKeyboardHook = 0 Then
            KeyboardHookProcedure 
= AddressOf KeyboardHookProc
            hKeyboardHook 
= SetWindowsHookEx(WH_KEYBOARD_LL, KeyboardHookProcedure, Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)), 0)
            
If hKeyboardHook = 0 Then
                StopMe()
                
Throw New Exception("SetWindowsHookEx ist failed.")
            
End If
        
End If
    
End Sub


    
Public Sub StopMe()
        
Dim retMouse As Boolean = True
        
Dim retKeyboard As Boolean = True
        
If Not (hMouseHook = 0Then
            retMouse 
= UnhookWindowsHookEx(hMouseHook)
            hMouseHook 
= 0
        
End If
        
If Not (hKeyboardHook = 0Then
            retKeyboard 
= UnhookWindowsHookEx(hKeyboardHook)
            hKeyboardHook 
= 0
        
End If
        
If Not (retMouse AndAlso retKeyboard) Then
            
Throw New Exception("UnhookWindowsHookEx failed.")
        
End If
    
End Sub


    
Private Const WM_MOUSEMOVE As Integer = 512
    
Private Const WM_LBUTTONDOWN As Integer = 513
    
Private Const WM_RBUTTONDOWN As Integer = 516
    
Private Const WM_MBUTTONDOWN As Integer = 519
    
Private Const WM_LBUTTONUP As Integer = 514
    
Private Const WM_RBUTTONUP As Integer = 517
    
Private Const WM_MBUTTONUP As Integer = 520
    
Private Const WM_LBUTTONDBLCLK As Integer = 515
    
Private Const WM_RBUTTONDBLCLK As Integer = 518
    
Private Const WM_MBUTTONDBLCLK As Integer = 521

    
Private Function MouseHookProc(ByVal nCode As IntegerByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
        
If (nCode >= 0Then
            
Dim button As MouseButtons = MouseButtons.None
            
Select Case wParam
                
Case WM_LBUTTONDOWN
                    button 
= MouseButtons.Left
                    
' break
                Case WM_RBUTTONDOWN
                    button 
= MouseButtons.Right
                    
' break
            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 = 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


    
Declare Auto Function ToAscii Lib "user32" (ByVal uVirtKey As IntegerByVal uScanCode As IntegerByVal lpbKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As IntegerAs Integer

    
Declare Auto Function GetKeyboardState Lib "user32" (ByVal pbKeyState As Byte()) As Integer

    
Private Const WM_KEYDOWN As Integer = 256
    
Private Const WM_KEYUP As Integer = 257
    
Private Const WM_SYSKEYDOWN As Integer = 260
    
Private Const WM_SYSKEYUP As Integer = 261

    
Private Key_Control_Down As Boolean = False
    
Private Key_Shift_Down As Boolean = False
    
Private Key_Alt_Down As Boolean = False

    
Private Function KeyboardHookProc(ByVal nCode As IntegerByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
        
If (nCode >= 0Then
            
Dim MyKeyboardHookStruct As KeyboardHookStruct = CType(Marshal.PtrToStructure(lParam, GetType(KeyboardHookStruct)), KeyboardHookStruct)
            
If (wParam = WM_KEYDOWN OrElse wParam = WM_SYSKEYDOWN) Then
                
Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
                
Select Case keydata
                    
Case Keys.LControlKey, Keys.RControlKey
                        Key_Control_Down 
= True
                    
Case Keys.LShiftKey, Keys.RShiftKey
                        Key_Shift_Down 
= True
                    
Case Keys.LMenu, Keys.RMenu
                        Key_Alt_Down 
= True
                
End Select

                
If Key_Control_Down Then
                    keydata 
= keydata Or Keys.Control
                
End If
                
If Key_Shift_Down Then
                    keydata 
= keydata Or Keys.Shift
                
End If
                
If Key_Alt_Down Then
                    keydata 
= keydata Or Keys.Alt
                
End If

                
Dim e As KeyEventArgs = New KeyEventArgs(keyData)
                
RaiseEvent KeyDown(Me, e)
            
End If
            
'If wParam = WM_KEYDOWN Then
            '    Dim keyState(-1) As Byte
            '    GetKeyboardState(keyState)
            '    Dim inBuffer(-1) As Byte
            '    If ToAscii(MyKeyboardHookStruct.vkCode, MyKeyboardHookStruct.scanCode, keyState, inBuffer, MyKeyboardHookStruct.flags) = 1 Then
            '        Dim e As KeyPressEventArgs = New KeyPressEventArgs(ChrW(inBuffer(0)))
            '        RaiseEvent KeyPress(Me, e)
            '    End If
            'End If
            If (wParam = WM_KEYUP OrElse wParam = WM_SYSKEYUP) Then
                
Dim keyData As Keys = CType(MyKeyboardHookStruct.vkCode, Keys)
                
Select Case keydata
                    
Case Keys.LControlKey, Keys.RControlKey
                        Key_Control_Down 
= False
                    
Case Keys.LShiftKey, Keys.RShiftKey
                        Key_Shift_Down 
= False
                    
Case Keys.LMenu, Keys.RMenu
                        Key_Alt_Down 
= False
                
End Select

                
If Key_Control_Down Then
                    keydata 
= keydata Or Keys.Control
                
End If
                
If Key_Shift_Down Then
                    keydata 
= keydata Or Keys.Shift
                
End If
                
If Key_Alt_Down Then
                    keydata 
= keydata Or Keys.Alt
                
End If

                
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

posted on 2005-02-25 13:25  myrat  阅读(2637)  评论(4编辑  收藏  举报

导航