键盘钩子（转载）

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

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

版权归属：http://woshishuixjht.blog.163.com/blog/static/36127269201043011559147/

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

'夜闻香原创，转载请保留此信息，万分感谢！
'博客:http://hi.baidu.com/clso
'论坛:http://cleclso.cn/
'QQ:315514678E-mail:clso@qq.com
'欢迎技术交流！


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

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

#Region"定义结构"

PrivateStructureMouseHookStruct
DimPTAsPOINT
DimHwndAsInteger
DimWHitTestCodeAsInteger
DimDwExtraInfoAsInteger
EndStructure

PrivateStructureMouseLLHookStruct
DimPTAsPOINT
DimMouseDataAsInteger
DimFlagsAsInteger
DimTimeAsInteger
DimDwExtraInfoAsInteger
EndStructure

PrivateStructureKeyboardHookStruct
DimvkCodeAsInteger
DimScanCodeAsInteger
DimFlagsAsInteger
DimTimeAsInteger
DimDwExtraInfoAsInteger
EndStructure

#EndRegion

#Region"API声明导入"

PrivateDeclareFunctionSetWindowsHookExLib"user32"Alias"SetWindowsHookExA"(ByValidHookAsInteger,ByVallpfnAsHookProc,ByValhModAsIntPtr,ByValdwThreadIdAsInteger)AsInteger
PrivateDeclareFunctionUnhookWindowsHookExLib"user32"(ByValidHookAsInteger)AsInteger
PrivateDeclareFunctionCallNextHookExLib"user32"(ByValidHookAsInteger,ByValnCodeAsInteger,ByValwParamAsInteger,ByVallParamAsIntPtr)AsInteger
PrivateDeclareFunctionToAsciiLib"user32"(ByValuVirtKeyAsInteger,ByValuScancodeAsInteger,ByVallpdKeyStateAsByte(),ByVallpwTransKeyAsByte(),ByValfuStateAsInteger)AsInteger
PrivateDeclareFunctionGetKeyboardStateLib"user32"(ByValpbKeyStateAsByte())AsInteger
PrivateDeclareFunctionGetKeyStateLib"user32"(ByValvKeyAsInteger)AsShort

PrivateDelegateFunctionHookProc(ByValnCodeAsInteger,ByValwParamAsInteger,ByVallParamAsIntPtr)AsInteger

#EndRegion

#Region"常量声明"

PrivateConstWH_MOUSE_LL=14
PrivateConstWH_KEYBOARD_LL=13
PrivateConstWH_MOUSE=7
PrivateConstWH_KEYBOARD=2
PrivateConstWM_MOUSEMOVE=&H200
PrivateConstWM_LBUTTONDOWN=&H201
PrivateConstWM_RBUTTONDOWN=&H204
PrivateConstWM_MBUTTONDOWN=&H207
PrivateConstWM_LBUTTONUP=&H202
PrivateConstWM_RBUTTONUP=&H205
PrivateConstWM_MBUTTONUP=&H208
PrivateConstWM_LBUTTONDBLCLK=&H203
PrivateConstWM_RBUTTONDBLCLK=&H206
PrivateConstWM_MBUTTONDBLCLK=&H209
PrivateConstWM_MOUSEWHEEL=&H20A
PrivateConstWM_KEYDOWN=&H100
PrivateConstWM_KEYUP=&H101
PrivateConstWM_SYSKEYDOWN=&H104
PrivateConstWM_SYSKEYUP=&H105

PrivateConstVK_SHIFTAsByte=&H10
PrivateConstVK_CAPITALAsByte=&H14
PrivateConstVK_NUMLOCKAsByte=&H90

#EndRegion

#Region"事件委托处理"

PrivateeventsAsNewSystem.ComponentModel.EventHandlerList

'''<summary>鼠标激活事件</summary>
PublicCustomEventMouseActivityAsMouseEventHandler
AddHandler(ByValvalueAsMouseEventHandler)
events.AddHandler("MouseActivity",value)
EndAddHandler
RemoveHandler(ByValvalueAsMouseEventHandler)
events.RemoveHandler("MouseActivity",value)
EndRemoveHandler
RaiseEvent(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.MouseEventArgs)
DimehAsMouseEventHandler=TryCast(events("MouseActivity"),MouseEventHandler)
IfehIsNotNothingTheneh.Invoke(sender,e)
EndRaiseEvent
EndEvent
'''<summary>键盘按下事件</summary>
PublicCustomEventKeyDownAsKeyEventHandler
AddHandler(ByValvalueAsKeyEventHandler)
events.AddHandler("KeyDown",value)
EndAddHandler
RemoveHandler(ByValvalueAsKeyEventHandler)
events.RemoveHandler("KeyDown",value)
EndRemoveHandler
RaiseEvent(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.KeyEventArgs)
DimehAsKeyEventHandler=TryCast(events("KeyDown"),KeyEventHandler)
IfehIsNotNothingTheneh.Invoke(sender,e)
EndRaiseEvent
EndEvent
'''<summary>键盘输入事件</summary>
PublicCustomEventKeyPressAsKeyPressEventHandler
AddHandler(ByValvalueAsKeyPressEventHandler)
events.AddHandler("KeyPress",value)
EndAddHandler
RemoveHandler(ByValvalueAsKeyPressEventHandler)
events.RemoveHandler("KeyPress",value)
EndRemoveHandler
RaiseEvent(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.KeyPressEventArgs)
DimehAsKeyPressEventHandler=TryCast(events("KeyPress"),KeyPressEventHandler)
IfehIsNotNothingTheneh.Invoke(sender,e)
EndRaiseEvent
EndEvent
'''<summary>键盘松开事件</summary>
PublicCustomEventKeyUpAsKeyEventHandler
AddHandler(ByValvalueAsKeyEventHandler)
events.AddHandler("KeyUp",value)
EndAddHandler
RemoveHandler(ByValvalueAsKeyEventHandler)
events.RemoveHandler("KeyUp",value)
EndRemoveHandler
RaiseEvent(ByValsenderAsObject,ByValeAsSystem.Windows.Forms.KeyEventArgs)
DimehAsKeyEventHandler=TryCast(events("KeyUp"),KeyEventHandler)
IfehIsNotNothingTheneh.Invoke(sender,e)
EndRaiseEvent
EndEvent

#EndRegion

PrivatehMouseHookAsInteger
PrivatehKeyboardHookAsInteger

PrivateSharedMouseHookProcedureAsHookProc
PrivateSharedKeyboardHookProcedureAsHookProc

#Region"创建与析构类型"

'''<summary>创建一个全局鼠标键盘钩子(请使用Start方法开始监视)</summary>
SubNew()
'留空即可
EndSub
'''<summary>创建一个全局鼠标键盘钩子，决定是否安装钩子</summary>
'''<paramname="InstallAll">是否立刻挂钩系统消息</param>
SubNew(ByValInstallAllAsBoolean)
IfInstallAllThenStartHook(True,True)
EndSub
'''<summary>创建一个全局鼠标键盘钩子，并决定安装钩子的类型</summary>
'''<paramname="InstallKeyboard">挂钩键盘消息</param>
'''<paramname="InstallMouse">挂钩鼠标消息</param>
SubNew(ByValInstallKeyboardAsBoolean,ByValInstallMouseAsBoolean)
StartHook(InstallKeyboard,InstallMouse)
EndSub
'''<summary>析构函数</summary>
ProtectedOverridesSubFinalize()
UnHook()'卸载对象时反注册系统钩子
MyBase.Finalize()
EndSub

#EndRegion

'''<summary>开始安装系统钩子</summary>
'''<paramname="InstallKeyboardHook">挂钩键盘消息</param>
'''<paramname="InstallMouseHook">挂钩鼠标消息</param>
PublicSubStartHook(OptionalByValInstallKeyboardHookAsBoolean=True,OptionalByValInstallMouseHookAsBoolean=False)
'注册键盘钩子
IfInstallKeyboardHookAndAlsohKeyboardHook=0Then
KeyboardHookProcedure=NewHookProc(AddressOfKeyboardHookProc)
hKeyboardHook=SetWindowsHookEx(WH_KEYBOARD_LL,KeyboardHookProcedure,Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)),0)
IfhKeyboardHook=0Then'检测是否注册完成
UnHook(True,False)'在这里反注册
ThrowNewWin32Exception(Marshal.GetLastWin32Error)'报告错误
EndIf
EndIf
'注册鼠标钩子
IfInstallMouseHookAndAlsohMouseHook=0Then
MouseHookProcedure=NewHookProc(AddressOfMouseHookProc)
hMouseHook=SetWindowsHookEx(WH_MOUSE_LL,MouseHookProcedure,Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)),0)
IfhMouseHook=0Then
UnHook(False,True)
ThrowNewWin32Exception(Marshal.GetLastWin32Error)
EndIf
EndIf
EndSub
'''<summary>立刻卸载系统钩子</summary>
'''<paramname="UninstallKeyboardHook">卸载键盘钩子</param>
'''<paramname="UninstallMouseHook">卸载鼠标钩子</param>
'''<paramname="ThrowExceptions">是否报告错误</param>
PublicSubUnHook(OptionalByValUninstallKeyboardHookAsBoolean=True,OptionalByValUninstallMouseHookAsBoolean=True,OptionalByValThrowExceptionsAsBoolean=False)
'卸载键盘钩子
IfhKeyboardHook<>0AndAlsoUninstallKeyboardHookThen
DimretKeyboardAsInteger=UnhookWindowsHookEx(hKeyboardHook)
hKeyboardHook=0
IfThrowExceptionsAndAlsoretKeyboard=0Then'如果出现错误，是否报告错误
ThrowNewWin32Exception(Marshal.GetLastWin32Error)'报告错误
EndIf
EndIf
'卸载鼠标钩子
IfhMouseHook<>0AndAlsoUninstallMouseHookThen
DimretMouseAsInteger=UnhookWindowsHookEx(hMouseHook)
hMouseHook=0
IfThrowExceptionsAndAlsoretMouse=0Then
ThrowNewWin32Exception(Marshal.GetLastWin32Error)
EndIf
EndIf
EndSub

'键盘消息的委托处理代码
PrivateFunctionKeyboardHookProc(ByValnCodeAsInteger,ByValwParamAsInteger,ByVallParamAsIntPtr)AsInteger
StatichandledAsBoolean:handled=False
IfnCode>=0AndAlso(events("KeyDown")IsNotNothingOrElseevents("KeyPress")IsNotNothingOrElseevents("KeyUp")IsNotNothing)Then
StaticMyKeyboardHookStructAsKeyboardHookStruct
MyKeyboardHookStruct=DirectCast(Marshal.PtrToStructure(lParam,GetType(KeyboardHookStruct)),KeyboardHookStruct)
'激活KeyDown
IfwParam=WM_KEYDOWNOrElsewParam=WM_SYSKEYDOWNThen'如果消息为按下普通键或系统键
DimeAsNewKeyEventArgs(MyKeyboardHookStruct.vkCode)
RaiseEventKeyDown(Me,e)'激活事件
handled=handledOre.Handled'是否取消下一个钩子
EndIf
'激活KeyUp
IfwParam=WM_KEYUPOrElsewParam=WM_SYSKEYUPThen
DimeAsNewKeyEventArgs(MyKeyboardHookStruct.vkCode)
RaiseEventKeyUp(Me,e)
handled=handledOre.Handled
EndIf
'激活KeyPress(TODO:此段代码还有BUG！)
IfwParam=WM_KEYDOWNThen
DimisDownShiftAsBoolean=(GetKeyState(VK_SHIFT)&&H80=&H80)
DimisDownCapslockAsBoolean=(GetKeyState(VK_CAPITAL)<>0)
DimkeyState(256)AsByte
GetKeyboardState(keyState)
DiminBuffer(2)AsByte
IfToAscii(MyKeyboardHookStruct.vkCode,MyKeyboardHookStruct.ScanCode,keyState,inBuffer,MyKeyboardHookStruct.Flags)=1Then
StatickeyAsChar:key=Chr(inBuffer(0))
'BUG所在
'IfisDownCapslockXorisDownShiftAndChar.IsLetter(key)Then
'key=Char.ToUpper(key)
'EndIf
DimeAsNewKeyPressEventArgs(key)
RaiseEventKeyPress(Me,e)
handled=handledOre.Handled
EndIf
EndIf
'取消或者激活下一个钩子
IfhandledThenReturn1ElseReturnCallNextHookEx(hKeyboardHook,nCode,wParam,lParam)
EndIf
EndFunction
'鼠标消息的委托处理代码
PrivateFunctionMouseHookProc(ByValnCodeAsInteger,ByValwParamAsInteger,ByVallParamAsIntPtr)AsInteger
IfnCode>=0AndAlsoevents("MouseActivity")IsNotNothingThen
StaticmouseHookStructAsMouseLLHookStruct
mouseHookStruct=DirectCast(Marshal.PtrToStructure(lParam,GetType(MouseLLHookStruct)),MouseLLHookStruct)
StaticmoubutAsMouseButtons:moubut=MouseButtons.None'鼠标按键
StaticmouseDeltaAsInteger:mouseDelta=0'滚轮值
SelectCasewParam
CaseWM_LBUTTONDOWN
moubut=MouseButtons.Left
CaseWM_RBUTTONDOWN
moubut=MouseButtons.Right
CaseWM_MBUTTONDOWN
moubut=MouseButtons.Middle
CaseWM_MOUSEWHEEL
StaticintAsInteger:int=(mouseHookStruct.MouseData>>16)And&HFFFF
'本段代码CLE添加，模仿C#的Short从Int弃位转换
Ifint>Short.MaxValueThenmouseDelta=int-65536ElsemouseDelta=int
EndSelect
StaticclickCountAsInteger:clickCount=0'单击次数
Ifmoubut<>MouseButtons.NoneThen
IfwParam=WM_LBUTTONDBLCLKOrElsewParam=WM_RBUTTONDBLCLKOrElsewParam=WM_MBUTTONDBLCLKThen
clickCount=2
Else
clickCount=1
EndIf
EndIf
DimeAsNewMouseEventArgs(moubut,clickCount,mouseHookStruct.PT.X,mouseHookStruct.PT.Y,mouseDelta)
RaiseEventMouseActivity(Me,e)
EndIf
ReturnCallNextHookEx(hMouseHook,nCode,wParam,lParam)'激活下一个钩子
EndFunction

'''<summary>键盘钩子是否有效</summary>
PublicPropertyKeyHookEnabled()AsBoolean
Get
ReturnhKeyboardHook<>0
EndGet
Set(ByValvalueAsBoolean)
IfvalueThenStartHook(True,False)ElseUnHook(True,False)
EndSet
EndProperty
'''<summary>鼠标钩子是否有效</summary>
PublicPropertyMouseHookEnabled()AsBoolean
Get
ReturnhMouseHook<>0
EndGet
Set(ByValvalueAsBoolean)
IfvalueThenStartHook(False,True)ElseUnHook(False,True)
EndSet
EndProperty

EndClass