在.net里使用全局钩子的代码
要在.net的环境里使用全局钩子，http://www.codeproject.com/csharp/globalhook.asp?df=100&forumid=57596&select=1047065#xx1047065xx 是一篇好文章，提供的代码也相当可用了
我把他转成了VB.net并fix了一些小bug，贴在这里。
调用方法：
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 Integer, ByVal 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 Integer, ByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As Integer) As Integer
Declare Auto Function UnhookWindowsHookEx Lib "user32.dll" (ByVal idHook As Integer) As Boolean
Declare Auto Function CallNextHookEx Lib "user32.dll" (ByVal idHook As Integer, ByVal nCode As Integer, ByVal 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 = 0) Then
retMouse = UnhookWindowsHookEx(hMouseHook)
hMouseHook = 0
End If
If Not (hKeyboardHook = 0) Then
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 Integer, ByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
If (nCode >= 0) Then
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 Integer, ByVal uScanCode As Integer, ByVal lpbKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As 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 Integer, ByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
If (nCode >= 0) Then
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
我把他转成了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 Integer, ByVal 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 Integer, ByVal lpfn As HookProc, ByVal hInstance As IntPtr, ByVal threadId As Integer) As Integer
Declare Auto Function UnhookWindowsHookEx Lib "user32.dll" (ByVal idHook As Integer) As Boolean
Declare Auto Function CallNextHookEx Lib "user32.dll" (ByVal idHook As Integer, ByVal nCode As Integer, ByVal 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 = 0) Then
retMouse = UnhookWindowsHookEx(hMouseHook)
hMouseHook = 0
End If
If Not (hKeyboardHook = 0) Then
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 Integer, ByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
If (nCode >= 0) Then
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 Integer, ByVal uScanCode As Integer, ByVal lpbKeyState As Byte(), ByVal lpwTransKey As Byte(), ByVal fuState As Integer) As 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 Integer, ByVal wParam As Int32, ByVal lParam As IntPtr) As Integer
If (nCode >= 0) Then
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
