用VB实现的全局键盘钩子
基于VB的键盘钩子算法的实现
输入 的运作 ，然 后根据 虚拟键 表判断 按键 的类 型 ， 最 后把 得到的准 确的按键类 型输 出。
２１ 键 盘 工作 流 程 图 （ １ ． 图 ）
少 的一 部分 在使 用计算机 进行操 作的 时候 ， 经常会 使用 到一些快捷 的操作方 式或获取 键盘 的按键 信息 ． 例 如使用 快捷 键来实 现复 制 、粘 贴或 是否 按 了 Ｅ ｃ ｓ、
２ 键 盘 模 块 （ ２ ． ３ 图 ）
机 息 ． 可以强制结 束消息 的传递 。 还 总 ２ 键 盘 钩 子 的 工作 原 理 第
三
一
３ 键 盘 钩 子 实现 算 法
使 用 不 同 的 Ｗ ｉｄｗ Ｐ 函 数 获 取 键 盘 的 动 作 ｎ ｏ ｓＡ Ｉ
固
９ １ ６
簟 麓纛 蠢
Ｔ ｂ 键 ａ Ｓｉ ｔ ｈｆ 键
ｖＫ ｙ ｓａｅ ｂ ｅ ｅ ｃ ｐ ｖ Ｋｙ ￣ ｅ ｂｅ Ｈ ｖＫｙ ｂｅ
ｖＫｙ ｒｎ ｂ ｅＰ ｉ ｔ ｖＫ ｙ ｂ ２ ６ ５ ９ ７
空 格 键 等 操 作 信 息 。 捷 键 具 有 操 作 简单 、 便 、 捷 快 方 快 等优 点 ． 就 需 要 我 们 在 编 写 程 序 代 码 的 过 程 中增 加 这 对 键 盘 的 按 键 进 行 判 断 ． 个 过 程 就 是 所 谓 的 键 盘 钩 这 子 功 能 利 用 Ｖ 在 Ｂ来 编 写 所 需 要 的 应 用 程 序 时 ． 于 由 Ｖ Ｂ无 法 直 接 对 系 统 的 注 册 表 进 行 操 作 对 于 此 类 操
图 １ 键 盘 工 作 流程 图
２２ 键 盘的虚拟键 简表 （ １ ． 表 ）
在 表 １中 ． 一 列 是 系 统 各 个 键 中 的 名 称 ． 二 第 第
简单易学 图文并茂 VB系统钩子与快捷键开发
简单易学图文并茂 系统钩子与快捷键开发创意和设计目标我喜欢将新建目录或者文件以日期打头，这样很方便排序和查找。
如下图：但每次新建目录后，都要手动输入日期。
这很不方便。
于是想到用快捷键了输入这个日期的创意。
目标是每当新建目录或文件后，按下F5键，自动插入当前日期。
为实现这个功能，可使用VB的Sends函数。
但因为需要程序在后台运行，因此打算把程序图标放到右下角的托盘中。
并且，因为它在按下F5键后执行，因此需要从系统中把按键信息捕捉出来，这就要用到系统钩子。
第一步创建一个Windows应用程序因为未来的程序在后台运行，因此它不需要任何界面。
这里把程序默认创建的Form的透明度设为0，把Border设为None，ControlBox设为0，ShowInTaskBar设为0。
这样它就不会在系统底部的状态栏出现了。
在Form上添加一个NotifyIcon，并指定一个喜欢的图标，这样程序在运行的时候，在右下角的托盘会出现一个图标。
之后，可以再加入一个ContextMenuStrip控件，并把它指定给NotifyIcon，这样右键点击图标的时候可以跳出控制菜单。
为方便调试，我在弹出目录中制作了两个功能，一个是显示和隐藏窗口，这个功能可为今后扩展用；一个是关闭功能，点击它可以关闭这个后台程序。
这两个功能不是我们的重点，这里只把代码贴出来。
***************************************************‘这个程序改变窗口的透明度，则窗口可以在桌面上显示和隐藏Private Sub changeShoe(ByVal sender As System.Object, ByVal e As KeyEventArgs)Select Case Me.OpacityCase 1Me.Opacity = 0Case 0Me.Opacity = 1End SelectEnd Sub‘这里将菜单第一项，即“Show Hide”和上述程序绑定起来Public Sub New()' 此调用是设计器所必需的。
VB 钩子详解
Windows钩子函数的概念和实现方法首先我们必须大致了解Windows的基本运作机理，Windows作为一个多任务操作系统，它是分有层次概念的，运行在最底下的称为Ring 0层，在这一层里基本上都是一些硬件驱动程序和Windows的总内核，一般的应用程序极少极少运行在这层，当然也有例外，例如调试软件SoftICE(不过基本上这个软件的作用是Crack软件而不是调试)、还原精灵还有分区魔法大师，就是运行在Ring 0层的，另外就是著名的CIH病毒。
运行在Ring 0级的程序能够对所有硬件进行直接地址级访问，所受到的限制也最小。
消息(Message)传递是Windows独有的一种机制，因为Windows规定运行在Ring 0以上的程序是没有权利知道究竟硬件发生了怎样的中断变化的，Windows统一将这些中断变化封装成一系列的消息(黑箱作业，也就是常说的Black Box)，比如鼠标移动，系统产生一个OnMouseMove消息(但这条消息从何而来，相关的硬件中断向量是什么，程序无从得知)，OnMouseMove这条消息最后送达每一个窗口程序以供处理。
在更高层次的地方，比如说控件级，所有的消息还被封装成一系列“事件”，比如TextBox控件有KeyPress事件，实际上，这些事件都是林林种种的消息映射。
事件的概念使得程序员能够更加傻瓜化地进行编程，但是从另一个角度来说，这种黑箱作业也使得程序员过分依赖系统的安排，限制了程序员的思维，举个例子，Windows为按钮控件封装了大部分常用的属性和事件，完成一般的常规妈作是没有问题的，但是很遗憾，或许是Windows的疏忽，按钮控件的字体颜色永远默认是黑色，而且Windows没有为此提供一个专门的接口来修改，碰到这种情况，程序员就会非常头疼。
钩子函数(Hook Function)，就像一把钩子，它的作用是将消息在抵达窗口程序之前先钩到一个地方以便程序员进行分析，这个地方称为挂接函数链，消息在这里先被一系列的函数处理然后由程序员决定是否交还给Windows系统，在这里，你可以“吞噬”(Lickup)一些你不希望发生的消息，比如说你吞掉所有的键盘消息而不交还给系统，那么键盘将会失灵。
VB钩子
'模块部分Public Type EV ENTMSGvKey As LongsKey As Longflag As Longtime As LongEnd TypeDec lare Function UnhookWindow sHookEx Lib "user32" (ByVal hHook As Long) As LongDec lare Function SetWindow sHookEx Lib "user32" Alias "SetWindow sHookE xA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dw ThreadId As Long) As LongDec lare Function CallNextHookE x Lib "user32" (ByVal hHook As Long, ByVal ncode As Lon g, ByVal w P aram As Long, lParam As Long) As LongPublic Declare Sub Copy Memory Lib "ker nel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Public my ms g As E V ENTMSGPublic Const WH_KE YBOA RD_LL = 13Public Const WM_KE Y DOWN = &H100Public hHook&, i%, appStr$, s1$, s2$, pos1$(), pos2$()Sub ints()appStr = "从" & Now & "开始键盘记录如下..." & vbCrLfs1 = "96 97 98 99 100 101 102 103 104 105 106 107 109 110 111 13 " + _"144 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 " + _"85 86 87 88 89 90 48 49 50 51 52 53 54 55 56 57 192 189 187 220 8 " + _"44 45 46 145 36 35 19 33 34 38 40 37 39 27 112 113 114 115 116 117 " + _"118 119 120 121 122 123 9 20 160 162 91 13 161 92 93"s2 = "小0 小1 小2 小3 小4 小5 小6 小7 小8 小9 小* 小+ 小- 小. 小/ " + _"小E nter 小NumLock A B C D E F G H I G K L M N O P Q R S T U V W X Y Z " + _"0 1 2 3 4 5 6 7 8 9 ` - = \ Bac kSpace " + _"P rintScreen Insert Delete ScrollLock Home End PauseBreak PageUp PageDow n " + _"上下左右E SC F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 " + _"TAB CapsLoc k 左Shift 左Ctr l 左Win Enter 右Shift 右Win 右List 右Ctrl"pos1 = Split(s1, " "): pos2 = Split(s2, " ")End SubPublic Function MyKBHook(ByVal ncode As Long, ByVal w P aram As Long, ByVal lP ar am As Long) As Long If ncode = 0 ThenIf w P aram = WM_KE Y DOWN ThenCopy Memory my msg, ByVal lParam, Len(my ms g)For i = 0 To UBound(pos1) - 1If my msg.vKey = Val(pos1(i)) ThenappStr = appStr & pos2(i) & " ": Exit ForEnd IfNextEnd IfEnd IfMy KBHook = CallNextHookE x(hHook, ncode, w P aram, lParam)End Function'窗体部分Dim fls$P r ivate Sub form_Load()Key P review = 1: ScaleMode = 3: AutoRedraw = 1: Caption = "键盘记录"Module1.ints '初始化数据hHook = SetWindow sHookE x(WH_KE Y BOA RD_LL, AddressOf MyKBHook, App.hInstance, 0) '加载If hHook = 0 Then E ndEnd SubP r ivate Sub For m_Unload(Cancel As Integer)Call UnhookWindow sHookE x(hHook) '程序退出时Open "D:\getkey.txt" For Append As #1 '打开文本P r int #1, Module1.appStr '一次性记录P r int #1, "到" & Now() & "结束!" & vbCr LfClose #1End SubP r ivate Sub For m_Key Dow n(KeyCode As Integer, Shift As Integer)If Key Code = vbKey E scape Then Unload MeEnd Sub一、新建一个ActiveX Dll工程，名字栏里取名为Sys Hook二、添加一个模块，取名为mHook，添加代码如下：Option E xplicitType POINTA PIx As Longy As LongEnd TypeType TMSGhw nd As Longmessage As Longw P aram As LonglP aram As Longtime As Longpt As P OINTA PIEnd TypePublic Declare Sub Copy Memory Lib "ker nel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)P r ivate Declar e Function CallNextHookE x Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal w P aram As Long, ByVal lParam As Long) As LongPublic hJournalHook As Long, hAppHook As LongPublic SHptr As LongPublic Const WM_CA NCELJOURNAL = &H4BPublic Function JournalRecordP r oc(ByVal nCode As Long, ByVal w P aram As Long, ByVal lParam As Long) As LongIf nCode < 0 ThenJournalRecordP roc = CallNextHookEx(hJournalHook, nCode, w P aram, lParam)E x it FunctionEnd IfResolvePointer(SHptr).FireE v ent lParamCall CallNextHookE x(hJournalHook, nCode, w P aram, lParam)End FunctionPublic Function AppHookProc(ByVal nCode As Long, ByVal w P ar am As Long, ByVal lParam As Long) As LongIf nCode < 0 ThenAppHookP roc = CallNextHookE x(hAppHook, nCode, w P aram, lP ar am)E x it FunctionEnd IfDim ms g As TMSGCopy Memory msg, ByVal lP ar am, Len(msg)Select Case ms g.messageCase WM_CA NCELJOURNALIf w P aram = 1 Then ResolvePointer(SHptr).Fir eE vent WM_CA NCELJOURNALEnd SelectCall CallNextHookE x(hAppHook, nCode, w P aram, ByVal lParam)End FunctionP r ivate Function ResolvePointer(ByVal lpObj&) As cSystemHookDim oSH As cSystemHookCopy Memory oSH, lpObj, 4&Set ResolvePointer = oSHCopy Memory oSH, 0&, 4&End Function三、把工程自动建立的Class1类模块改名为cSystemHook，添加代码如下：Option E xplicitPublic E v ent MouseDow n(Button As Integer, Shift As Integer, x As Single, y As Single)Public E v ent MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)Public E v ent MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)Public E v ent Key Dow n(KeyCode As Integer, Shift As Integer)Public E v ent Key Up(Key Code As Integer, Shift As Integer)Public E v ent SystemKey Dow n(KeyCode As Integer)Public E v ent SystemKey Up(Key Code As Integer)P r ivate Declar e Function SetWindow sHookE x Lib "user32" Alias "SetWindow sHookE xA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dw ThreadId As Long) As LongP r ivate Declar e Function UnhookWindowsHookE x Lib "user32" (ByVal hHook As Long) As LongP r ivate Declar e Function GetAsyncKeyState% Lib "user32" (ByVal v Key As Long)P r ivate Const WM_KE Y DOWN = &H100P r ivate Const WM_KE Y UP = &H101P r ivate Const WM_MOUSEMOV E = &H200P r ivate Const WM_LBUTTONDOWN = &H201P r ivate Const WM_LBUTTONUP = &H202P r ivate Const WM_LBUTTONDBLCLK = &H203P r ivate Const WM_RBUTTONDOWN = &H204P r ivate Const WM_RBUTTONUP = &H205P r ivate Const WM_RBUTTONDBLCLK = &H206P r ivate Const WM_MBUTTONDOWN = &H207P r ivate Const WM_MBUTTONUP = &H208P r ivate Const WM_MBUTTONDBLCLK = &H209P r ivate Const WM_MOUSEWHEEL = &H20AP r ivate Const WM_SYSTEMKEY DOWN = &H104P r ivate Const WM_SYSTEMKEY UP = &H105P r ivate Const WH_JOURNALRECORD = 0P r ivate Const WH_GETMESSAGE = 3P r ivate Type E V ENTMSGw Msg As LonglP aramLow As LonglP aramHigh As LongmsgTime As LonghWndMsg As LongEnd TypeDim EMSG As E V ENTMSGPublic Function SetHook() As BooleanIf hJournalHook = 0 Then hJournalHook = SetWindow sHookE x(WH_JOURNALRECORD, AddressOf JournalRecordP roc, App.hInstance, 0)If hAppHook = 0 Then hAppHook = SetWindow sHookE x(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)SetHook = TrueEnd FunctionPublic Sub RemoveHook()UnhookWindow sHookE x hAppHookUnhookWindow sHookE x hJournalHookEnd SubP r ivate Sub Class_Initialize()SHptr = ObjP tr(Me)End SubP r ivate Sub Class_Ter minate()If hJournalHook Or hAppHook Then RemoveHookEnd SubFriend Function FireEvent(ByVal lP aram As Long)Dim i%, j%, k%Dim s As Str ingIf lParam = WM_CA NCELJOURNA L ThenhJournalHook = 0SetHookE x it FunctionEnd IfCopy Memory EMSG, ByVal lP ar am, Len(EMSG)Select Case EMSG.w MsgCase WM_KE Y DOWNj = 0If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey Control) Then j = (j Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey Menu) Then j = (j Or 4) 'fixed by JJs = Hex(EMSG.lP ar amLow)k = (EMSG.lParamLow And &HFF)RaiseE v ent Key Dow n(k, j)s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJEMSG.lParamLow = CLng("&h" & s)Copy Memory ByVal lParam, EMSG, Len(EMSG)Case WM_KE Y UPj = 0 'fixed by JJIf GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey Control) Then j = (j Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey Menu) Then j = (j Or 4) 'fixed by JJs = Hex(EMSG.lP ar amLow)k = (EMSG.lParamLow And &HFF)RaiseE v ent Key Up(k, j)s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJEMSG.lParamLow = CLng("&h" & s)Copy Memory ByVal lParam, EMSG, Len(EMSG)Case WM_MOUSEMOV Ei = 0 'fixed by JJIf GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey RButton) Then i = (i Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey MButton) Then i = (i Or 4) 'fixed by JJj = 0 'fixed by JJIf GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey Control) Then j = (j Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey Menu) Then j = (j Or 4) 'fixed by JJRaiseE v ent MouseMove(i, j, CSng(EMSG.lP aramLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWNi = 0 'fixed by JJIf GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey Control) Then i = (i Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey Menu) Then i = (i Or 4) 'fixed by JJRaiseE v ent MouseDow n(2 ^ ((EMSG.w Msg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUPi = 0 'fixed by JJIf GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJIf GetAsyncKeyState(vbKey Control) Then i = (i Or 2) 'fixed by JJIf GetAsyncKeyState(vbKey Menu) Then i = (i Or 4) 'fixed by JJRaiseE v ent MouseUp(2 ^ ((EMSG.w Msg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_SYSTEMKE Y DOWNs = Hex(EMSG.lP ar amLow)k = (EMSG.lParamLow And &HFF)If k <> vbKey Menu Then RaiseE vent SystemKey Dow n(k)s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJEMSG.lParamLow = CLng("&h" & s)Copy Memory ByVal lParam, EMSG, Len(EMSG)Case WM_SYSTEMKE Y UPs = Hex(EMSG.lP ar amLow)k = (EMSG.lParamLow And &HFF)If k <> vbKey Menu Then RaiseE vent SystemKey Up(k)s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJEMSG.lParamLow = CLng("&h" & s)Copy Memory ByVal lParam, EMSG, Len(EMSG)Case ElseEnd SelectEnd Function四、千万别望了保存（否则你要后悔的），编译生成DLL，然后可以测试了，做一个普通的工程，添加引用SysHook，在窗体中添加测试代码（嘿嘿，可能你会吃点苦头）：Option E xplicitDim WithE v ents sh As cSystemHookP r ivate Sub For m_Load()Set sh = New cSystemHooksh.SetHookEnd SubP r ivate Sub For m_Unload(Cancel As Integer)sh.RemoveHookSet sh = NothingEnd SubP r ivate Sub sh_MouseDow n(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = 1 ThenMsgBox "你按了左键"End IfIf Button = 2 ThenMsgBox "你按了右键"End IfEnd Sub五、接着你可以试试全局的下列事件（记住刚才的教训，可要小心哦）：P r ivate Sub sh_Key Dow n(KeyCode As Integer, Shift As Integer)End SubP r ivate Sub sh_Key Up(Key Code As Integer, Shift As Integer)End SubMouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)End SubP r ivate Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) End SubP r ivate Sub sh_SystemKey Dow n(KeyCode As Integer)End SubP r ivate Sub sh_SystemKey Up(KeyCode As Integer) End Sub。
VB键盘钩子源码：截取一切键盘按键
VB键盘钩子源码：截取一切键盘按键(2011-07-15 10:52:11)转载▼分类：我的VB标签：杂谈1、UI设计：2、程序源码：（1）FrmHook源码Option ExplicitDim WithEvents Hook As ClsHook '创建一个需要事件支持的Hook为模块ClsHookPrivate Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long'根据指定的映射类型，执行不同的扫描码和字符转换'' uCode Long，欲转换的源字符或代码' uMapType Long，控制映射类型，如下所示' 0 —— uCode是个虚拟键码?函数返回相应的扫描码' 1 —— uCode是个扫描码?函数返回相应的虚拟键码' 2—— uCode是个虚拟键码。
函数返回相应的ASCII值（未加Shift组合键）。
针对死键，高位设为1。
如果出错，返回NULL' dwhkl Long，键盘布局的句柄Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long'取得一个句柄，描述指定应用程序的键盘布局' dwLayout ，//欲检查的线程的标识符Private Declare Function GetForegroundWindow Lib "user32" () As LongPrivate Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long'获取与指定窗口关联在一起的一个进程和线程标识符' lpdwProcessId Long，指定一个变量，用于装载拥有那个窗口的一个进程的标识符' hwnd Long，指定窗口句柄Private Sub Form_Load()Set Hook = New ClsHookHook.SetHook'App.TaskVisible = FalseMe.HideEnd SubPrivate Sub Form_Unload(Cancel As Integer)Hook.UnHookSet Hook = NothingEnd SubPrivate Sub Hook_KeyDown(KeyCode As Integer, Shift As Integer) '钩子的KeyDown事件，在模块中我们自己定义的事件KeyDownDim StrCode As StringStrCode = CodeToString(KeyCode)'判断ShiftIf StrCode = "[Shift]" Or StrCode = "[Alt]" Or StrCode = "[Ctrl]" ThenIf Shift = vbAltMask + vbCtrlMask Then StrCode = "[Alt + Ctrl]"If Shift = vbAltMask + vbShiftMask Then StrCode = "[Alt + Shift]"If Shift = vbCtrlMask + vbShiftMask Then StrCode = "[Ctrl + Shift]"If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = "[Ctrl + Shift +Alt]"ElseIf Shift = vbShiftMask Then StrCode = StrCode & " + [Shift]"If Shift = vbCtrlMask Then StrCode = StrCode & " + [Ctrl]"If Shift = vbAltMask Then StrCode = StrCode & " + [Alt]"If Shift = vbAltMask + vbCtrlMask Then StrCode = StrCode & " + [Alt + Ctrl]"If Shift = vbAltMask + vbShiftMask Then StrCode = StrCode & " + [Alt + Shift]"If Shift = vbCtrlMask + vbShiftMask Then StrCode = StrCode & " + [Ctrl + Shift]"If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = StrCode & " + [Ctrl + Shift+Alt]"End If'热键Ctrl+J，呼出窗口If StrCode = "[j] + [Ctrl]" ThenMe.ShowApp.TaskVisible = TrueEnd IfText1.Text = Text1.Text & Now & "------" & StrCode & vbCrLfEnd Sub'把按键码换为StringPrivate Function CodeToString(nCode As Integer) As String Dim StrKey As StringSelect Case nCodeCase vbKeyBack: StrKey = "BackSpace"Case vbKeyTab: StrKey = "Tab"Case vbKeyClear: StrKey = "Clear"Case vbKeyReturn: StrKey = "Enter"Case vbKeyShift: StrKey = "Shift"Case vbKeyControl: StrKey = "Ctrl"Case vbKeyMenu: StrKey = "Alt"Case vbKeyPause: StrKey = "Pause"Case vbKeyCapital: StrKey = "CapsLock"Case vbKeyEscape: StrKey = "ESC"Case vbKeySpace: StrKey = "SPACEBAR"Case vbKeyPageUp: StrKey = "PAGE UP"Case vbKeyPageDown: StrKey = "PAGE DOWN"Case vbKeyEnd: StrKey = "END"Case vbKeyHome: StrKey = "HOME"Case vbKeyLeft: StrKey = "LEFT ARROW"Case vbKeyUp: StrKey = "UP ARROW"Case vbKeyRight: StrKey = "RIGHT ARROW"Case vbKeyDown: StrKey = "DOWN ARROW"Case vbKeySelect: StrKey = "SELECT"Case vbKeyPrint: StrKey = "PRINT SCREEN"Case vbKeyExecute: StrKey = "EXECUTE"Case vbKeySnapshot: StrKey = "SNAPSHOT"Case vbKeyInsert: StrKey = "INS"Case vbKeyDelete: StrKey = "DEL"Case vbKeyHelp: StrKey = "HELP"Case vbKeyNumlock: StrKey = "NUM LOCK"Case vbKey0 To vbKey9: StrKey = Chr$(nCode)Case vbKeyA To vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))Case vbKeyF1 To vbKeyF16: StrKey = "F" & CStr(nCode - 111)Case vbKeyNumpad0 To vbKeyNumpad9: StrKey = "Numpad " & CStr(nCode - 96)Case vbKeyMultiply: StrKey = "Numpad {*}"Case vbKeyAdd: StrKey = "Numpad {+}"Case vbKeySeparator: StrKey = "Numpad {ENTER}"Case vbKeySubtract: StrKey = "Numpad {-}"Case vbKeyDecimal: StrKey = "Numpad {.}"Case vbKeyDivide: StrKey = "Numpad {/}"Case ElseStrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) End SelectCodeToString = "[" & StrKey & "]"End FunctionPrivate Sub text1_Change()Text1.SelStart = Len(Text1.Text)End Sub（2）ModHook源码Option ExplicitPublic Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As LongPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)Public OldHook As Long '全局变量OldHook存储钩子句柄Public LngClsPtr As Long '保存对象地址'回调函数Public Function BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As LongIf nCode < 0 Then '如果nCode小于0，上次就说过喽，小于0代表没有拦截到键盘消息;当nCode为0的时候，所有的键盘消息都将被拦截，BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam) 'wParam为消息的种类（种类知道吧？KeyDown ……）lparam存储了拦截到的消息；没有拦截到消息只好呼叫下个钩子Exit FunctionEnd IfResolvePointer(LngClsPtr).RiseEvent (lparam) '得到消息的地址'处理过后一定要将消息归还给系统，难免还有别人要这个消息呢？Call CallNextHookEx(OldHook, nCode, wParam, lparam)End Function'得到对象的地址Private Function ResolvePointer(ByVal lpObj As Long) As ClsHookDim oSH As ClsHookCopyMemory oSH, lpObj, 4&Set ResolvePointer = oSHCopyMemory oSH, 0&, 4&End Function（3）ClsHook源码：Option Explicit '声明,在VB中，开头使用声明可以减少很多的错误Public Event KeyDown(KeyCode As Integer, Shift As Integer) '自定义事件KeyDownPrivate Type EVENTMSG '定义事件消息的类型wMsg As Long '消息lParamLow As LonglParamHigh As LongmsgTime As Long '消息时间hWndMsg As Long '消息句柄End Type'Private Const WH_GETMESSAGE As Long = 3Private Const WH_JOURNALRECORD = 0Private Const WM_KEYDOWN = &H100Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long 'dwThreadId监控代码,0为全局钩子Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer Public Sub SetHook()OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0) End SubPublic Sub UnHook()Call UnhookWindowsHookEx(OldHook)End SubFriend Function RiseEvent(ByVal lparam As Long) As LongDim Msg As EVENTMSGDim IntShift As Integer 'ShiftDim IntCode As Integer 'KeyCodeCopyMemory Msg, ByVal lparam, Len(Msg) '利用指针技术将消息从lparam中的数据拷贝到Msg的地址中,简单的说就是把lparam的数据赋值给MsgIntShift = 0Select Case Msg.wMsg '检查消息状态Case WM_KEYDOWN '如果消息的事件为KeyDown（键盘按下）'得到Shift,Ctrl,Alt的按键状态If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)IntCode = Msg.lParamLow And &HFF '得到KeyCode（及按键码）RaiseEvent KeyDown(IntCode, IntShift) 'RaiseEvent 引发模块(ClsHook)中声明的事件KeyDownEnd SelectEnd FunctionPrivate Sub Class_Initialize() '初始化类LngClsPtr = ObjPtr(Me) 'ObjPtr，返回对象的地址，将本类的存储地址返回给变量LngClsPtrEnd Sub3、软件运行效果：运行后自动隐藏，按ctrl+j调出程序显示：。
在VB中使用DirectX组件进行键盘的全局HOOK
Private Sub Form_Load()
Set DX = New DirectX7 '建立DirectX对象
Set DI = DX.DirectInputCreate() '建立DirectInput对象
Set DI_Keyboard = DI.CreateDevice("GUID_SysKeyboard") '建立DirectInput的键盘对象
DI_Keyboard.SetCommonDataFormat DIFORMAT_KEYBOARD '设置数据格式
DI_Keyboard.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE '设置协作模式（就是DX设备要与某个窗口关联）。DISCL_BACKGROUND这个是最重要的，它让程序即使在后台运行也能监视键盘输入，不然怎么做HOOK呢^_^
Close #1
key_num = 0
End If
End Sub
好了，基本上就是这样，代码的注释也比较详细，希望对大家有帮助。有什么问题可以联系我，QQ：511795070
顺便再说一下，想用这个方法拦截QQ登陆框的密码是无效m DX As DirectX7
Dim DI As DirectInput
Dim DI_Keyboard As DirectInputDevice
Dim key_state As DIKEYBOARDSTATE '存储键盘状态的结构变量
Dim key_num As Integer '保存键盘扫描码
DX有不同的版本，VB提供了对DX7和DX8的支持，更高版本的就不支持了-_-\。不过没关系，因为DX是向下兼容的，所以，如果你安装的是DX10的话，DX7和8也是可以用的。这里我们就介绍在DX7中访问键盘的方法。VB要使用DX库，必须先在工程中引用这个库，很简单：单击菜单栏的“工程”--引用--在“引用”对话框中找到“DirectX 7 For Visual Basic Type Library”，把前面的钩打上，然后确定，就可以了。然后就可以使用DX库创建DX对象。首先，建立一个DX7主对象，像这样：Dim DX As New DirectX7，然后，使用DX对象的DirectInputCreate方法可以创建一个DirectInput对象：Set DI = DX.DirectInputCreate()，再然后，用DirectInput对象的CreateDevice方法就可以创建一个键盘或鼠标对象了（根据参数决定）。比如创建键盘对象就这样：Set DI_Keyboard = DI.CreateDevice("GUID_SysKeyboard")。有了键盘对象DI_Keyboard，就可以用它来访问键盘输入了。
VB2010VBNET源码 HOOK 键盘钩子
Case Else
'do nothing
End Select
End Sub
这只是简单的屏蔽了几个键，当然如果要屏蔽更多的键，只要在模块的LowLevelKeyboardProc函数中设置你想要拦截键盘键值过滤掉就可以了。
Call CopyMemory(p, ByVal lParam, Len(p))
If p.vkCode = VK_LWIN Or p.vkCode = VK_RWIN Then blnHook = True '按下了左/右Win键
If p.vkCode = VK_CONTROL Or p.vkCode = VK_ESCAPE Then blnHook = True '按下了Ctrl+Esc键
End Type
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP e Const VK_LWIN = &H5B
End Function
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
App.hInstance, _
VB 钩子详解
Windows钩子函数的概念和实现方法首先我们必须大致了解Windows的基本运作机理，Windows作为一个多任务操作系统，它是分有层次概念的，运行在最底下的称为Ring 0层，在这一层里基本上都是一些硬件驱动程序和Windows的总内核，一般的应用程序极少极少运行在这层，当然也有例外，例如调试软件SoftICE(不过基本上这个软件的作用是Crack软件而不是调试)、还原精灵还有分区魔法大师，就是运行在Ring 0层的，另外就是著名的CIH病毒。
运行在Ring 0级的程序能够对所有硬件进行直接地址级访问，所受到的限制也最小。
消息(Message)传递是Windows独有的一种机制，因为Windows规定运行在Ring 0以上的程序是没有权利知道究竟硬件发生了怎样的中断变化的，Windows统一将这些中断变化封装成一系列的消息(黑箱作业，也就是常说的Black Box)，比如鼠标移动，系统产生一个OnMouseMove消息(但这条消息从何而来，相关的硬件中断向量是什么，程序无从得知)，OnMouseMove这条消息最后送达每一个窗口程序以供处理。
在更高层次的地方，比如说控件级，所有的消息还被封装成一系列“事件”，比如TextBox控件有KeyPress事件，实际上，这些事件都是林林种种的消息映射。
事件的概念使得程序员能够更加傻瓜化地进行编程，但是从另一个角度来说，这种黑箱作业也使得程序员过分依赖系统的安排，限制了程序员的思维，举个例子，Windows为按钮控件封装了大部分常用的属性和事件，完成一般的常规妈作是没有问题的，但是很遗憾，或许是Windows的疏忽，按钮控件的字体颜色永远默认是黑色，而且Windows没有为此提供一个专门的接口来修改，碰到这种情况，程序员就会非常头疼。
钩子函数(Hook Function)，就像一把钩子，它的作用是将消息在抵达窗口程序之前先钩到一个地方以便程序员进行分析，这个地方称为挂接函数链，消息在这里先被一系列的函数处理然后由程序员决定是否交还给Windows系统，在这里，你可以“吞噬”(Lickup)一些你不希望发生的消息，比如说你吞掉所有的键盘消息而不交还给系统，那么键盘将会失灵。
基于VB的键盘钩子算法的实现
基于VB的键盘钩子算法的实现
周仁云;张关明
【期刊名称】《现代计算机（专业版）》
【年(卷),期】2009(000)012
【摘要】键盘,作为计算机录入的重要工具,在编程和计算机控制中占有重要地位.介绍利用VB实现键盘钩子的几种算法,通过这几种算法的介绍,使计算机用户了解计算机中与键盘钩子方面有关知识(Windows API),掌握键盘如何实现记录和控制的过程,从而提高对键盘操作安全性的提高和警惕.
【总页数】3页(P198-200)
【作者】周仁云;张关明
【作者单位】海南软件职业技术学院信息管理系,琼海,571400;海南软件职业技术学院信息管理系,琼海,571400
【正文语种】中文
【相关文献】
1.基于VB的飞行程序基本参数自动计算算法实现 [J], 沈敏;吴森
2.基于Excel VBA的线路坐标计算算法及其实现 [J], 周凯;赵彬彬;刘泉菲
3.基于Excel VBA角度转换问题的算法研究及其实现 [J], 姚德生;赵淑湘
4.一种基于VB的直接修改文件时间FILETIME的算法实现 [J], 丁志云
5.基于VB
6.0的排序算法动态演示软件的设计与实现 [J], 高向敏
因版权原因，仅展示原文概要，查看原文内容请购买。
VB的钩子
VB的钩子：本来是因为要做一个小软件，其中要实现的一部分是用鼠标来定位一个座标，那么也就是说本身窗体的焦点可能会离开，就不能使用form的mousedown事件了，那么，使用钩子是可以实现的。
基本想法就是，用钩子获取鼠标点击消息，然后将光标所在的座标记录下来，钩子分为线程钩子和系统钩子。
线程钩子只能钩取本线程的消息，而系统钩子能勾取系统中所有的消息。
VB能实现的只是线程钩子。
而且就算是线程钩子好像对鼠标的操作也不会成功！！学习总是由问题引起的，可能这个问题很简单，但是我努力的去找答案一定会有收获对吗？呵呵。
第一步：建立钩子。
在我的理解，其实就是使用一个API函数，将一个回调函数的地址加入一个钩子队列中，当然可能这个队列只有一个钩子。
那么当发生硬件中断或者软中断的时候，操作系统对这个消息处理的时候，就会照顾到这个钩子，选择一个应用程序的函数来处理它。
vb 的钩子函数是放在一个模块中的，而且在申明的时候都是用public,即在moulde中，呵呵，不知道有没有写错。
好了要想建立钩子，用的是Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long这个API 函数。
很简单看看这个括号里的几个参数的意义：SetWindowsHookEx 参数有4个idHook As Long 钩子的类型。
以WH_打头的常数，如键盘钩子就是WH_KEYBOARD = 2这些常数在APIViewer里都有。
lpfn As Long 钩子函数的指针。
也就是你在公共模块中定义用来完成你需要的处理的函数或过程。
VB技巧全局键盘消息钩子
[VB技巧]全局键盘消息钩子程序中的代码：Private Sub Command1_Click()hHook=Hook_安装钩子(WH_KEYBOARD_LL,AddressOf按键消息_自定义回调函数)'安装钩子End SubPrivate Sub Command2_Click()Call Hook_卸载钩子(hHook) '释放钩子End Sub模块中的代码：'消息内容说明:''消息包含的信息有nCode,wParam,lParam这3个,本例以键盘钩子为例. ''nCode:'当nCode等于HC_ACTION时,wParam和lParam包含鼠标信息. '当nCode等于HC_NOREMOVE时,wParam和lParam包含鼠标信息，并且鼠标消息没有从消息队列里移除'wParam:'包含内容为消息事件.例如本例中"WM_KEYDOWN"事件.在本例中是用来筛选出"WM_KEYDOWN"事件的消息.'lParam:'包含了消息的内容,是一个结构型数据(EVENTMSG).包含了消息的所有内容,具体请查看声明里的注释'本hook为全局键盘hook，能hook所有键盘消息，而且是在系统处理消息前优先处理。
(这个功能需要选择WH_KEYBOARD_LL这个钩子)'如果不懂代码，只修改“按键消息_自定义回调函数”这个函数即可。
切勿修改其他代码。
Public hHook As Long '该挂钩处理过程的句柄Private Declare Function UnhookWindowsHookEx Lib"user32"(ByVal hHook As Long)As Long'卸载钩子函数声明'hHook:钩子句柄Private Declare Function SetWindowsHookEx Lib"user32" Alias"SetWindowsHookExA"(ByVal idHook As Long,ByVal lpfn As Long,ByVal hmod As Long,ByVal dwThreadId As Long)As Long '安装钩子函数声明'idHook:钩子类型(具体请查看"常用的钩子")'lpfn:回调函数的地址,用"AddressOf函数名"的方式直接作为参数传入函数.要注意的是这个回调函数必须在程序的标准模块中'hmod:实例句柄App.hInstance'dwThreadId:线程ID'返回值:若此函数执行成功,则返回值就是该挂钩处理过程的句柄;若此函数执行失败,则返回值为NULL(0).若想获得更多错误信息,请调用GetLasError 函数.Private Declare Function CallNextHookEx Lib"user32" (ByVal hHook As Long,ByVal nCode As Long,ByVal wParam As Long, lParam As Any)As Long'调用下一个钩子函数的声明Private Declare Sub CopyMemory Lib"kernel32"Alias "RtlMoveMemory"(Destination As Any,Source As Any,ByVal Length As Long)'复制内存块函数的声明Private Type EVENTMSG '结构化类型声明message As Long '在键盘消息中,包含的是按键码信息paramL As Long '32位消息的特定附加信息paramH As Long '32位消息的特定附加信息time As Long'在键盘消息中,包含的是消息发生的时间hwnd As Long '窗口句柄End Type'常量声明'--------------------------------------------------------------------------------------'常用的钩子'消息类型常量标识值消息类型适用范围Public Const WH_CALLWNDPROC=4 '发给窗口的消息线程或系统Public Const WH_CALLWNDPROCRET=12 '窗口返回的消息线程或系统Public Const WH_CBT=5 '窗口变化、焦点设定等消息线程或系统Public Const WH_DEBUG=9 '是否执行其它Hook的Hook线程或系统Public Const WH_FOREGROUNDIDLE=11 '前台程序空闲线程或系统Public Const WH_GETMESSAGE=3 '投放至消息队列中的消息线程或系统Public Const WH_JOURNALPLAYBACK=1 '将所记载的消息进行回放系统Public Const WH_JOURNALRECORD=0 '监视并记录输入消息系统Public Const WH_KEYBOARD=2 '键盘消息线程或系统Public Const WH_MOUSE=7 '鼠标消息线程或系统Public Const WH_MSGFILTER=-1 '菜单滚动条、对话框消息线程或系统Public Const WH_SHELL=10 '外壳程序的消息线程或系统Public Const WH_SYSMSGFILTER=6 '所有线程的菜单滚动条、对话框消息系统Public Const WH_KEYBOARD_LL=13 '钩子类型'WH_KEYBOARD一般还是在系统处理后处理，注入式键盘挂钩（注入dll到目标进程估计没人会喜欢），所以像Ctrl+alt+del系统会先处理掉，WH_KEYBOARD没法截获'WH_KEYBOARD_LL是在系统处理前处理的，所以很容易引起挂起之类的问题，不过操作系统通过LowLevelHooksTimeout控制超时，如果这个时间后HOOK函数还没返回，就直接被忽略了'--------------------------------------------------------------------------------------Public Const HC_ACTION=0'ncode的值,包含鼠标信息Public Const WM_KEYDOWN=&H100 '键盘消息（按键按下）Public Const WM_KEYUP=&H101 '键盘消息（按键弹起）Public Const WM_SYSKEYDOWN=&H104'键盘消息（系统按键按下）Public Const WM_SYSKEYUP=&H105 '键盘消息（系统按键弹起）Private HookMsg As EVENTMSG '结构化类型实体化'将数据写入TXTPublic Sub PrintTXT(ByVal CaseStr As String)Open"c:\键盘记录.txt"For Append As#1Print#1,CaseStrClose#1End Sub'***************************************************************** ********'**函数名：Hook_卸载钩子'**输入：ByVal hHook(Long)-钩子句柄'**输出：1表示成功,0表示失败'**功能描述：卸载指定句柄的钩子'***************************************************************** ********Public Function Hook_卸载钩子(ByVal挂起函数句柄As Long)Hook_卸载钩子=UnhookWindowsHookEx(hHook)End Function'***************************************************************** ********'**函数名：Hook_安装钩子'**输入：ByVal钩子类型(Long)-钩子类型,WH_KEYBOARD_LL为键盘钩子'**：ByVal回调函数地址(Long)-回调函数的地址,表示方式为AddressOf回调函数'**：ByVal实例句柄(Long)-App.hInstance'**：Optional线程ID(Long=0)-默认为0'**输出：返回>0表示成功(hhook钩子句柄)'**功能描述：安装指定句柄钩子'***************************************************************** ********Public Function Hook_安装钩子(ByVal钩子类型As Long,ByVal回调函数地址As Long)As LongHook_安装钩子=SetWindowsHookEx(钩子类型,回调函数地址, App.hInstance,0)End Function'***************************************************************** ********'**函数名：按键消息_自定义回调函数'**输入：ByVal ncode(Long)-nCode跟所有其他钩子处理函数一样，只要记得当nCode小于0时：调用CallNextHookEx()就可以了。
VB HOOK
hmod 代表.DLL的hInstance，如果是Local Hook，该值可以是Null(VB中可传0进去)，
而如果是Remote Hook，则可以使用GetModuleHandle(".dll名称")来传入。
dwThreadId 代表执行这个Hook的ThreadId，如果不设定是那个Thread来做，则传0(所以
在高位元组。
HOTKEYF_ALT ALT key
HOTKEYF_CONTROL CTRL key
HOTKEYF_EXT Extended key
HOTKEYF_SHIFT SHIFT
SendMessage()的传回值有以下的意义：
-1 hotkey 设定不对
ByVal wParam As Long, _
ByVal lParam As Long ) As Long
nCode 代表是什麽请况之下所产生的Hook，随Hook的不同而有不同组的可能值
Public Const WH_GETMESSAGE = 3
Public Const WH_HARDWARE = 8
Public Const WH_JOURNALPLAYBACK = 1
Public Const WH_JOURNALRECORD = 0
If hHook <> 0 Then
Exit Function
End If
hhook = SetWindowsHookEx(WH_KEYBOARD, AddressOf _
MyKBHFunc, App.hInstance, App.ThreadId)
End Function
VB编程中应用全局钩子实现应用程序的一键隐藏与显示
Ｋｅ ｒ ｓ ｙ ａ ｃ ｌ ｋ ｌ ｒｒ ； ｅ ｔ ｏ ｋ； Ｉ； ｏ ｋ ｆ ｎ ｔ ｎ ｙ ｗｏ ｄ ：ｄ ｎ ｍｉ ｉ ｉ ａｙ ｒ ｍｏ ｅｈ ｏ ＡＰ ｈ ｏ ｃ ｉ ｎ ｂ ｕ ｏ
１ 问题 的引入
尝试 着 将 全 局 钩子 技 术 应 用 到 了 Ｖ Ｂ编 程 中 ，用 来 实 现 内
存 中带有 句 柄 应 用程 序 窗 口的 一 键 隐 藏 与显 示 ，用 Ｖ Ｂ做 如 下
发 往 指 定 窗 口 的 消息 或 特 定 事 件 ，其 监 视 的窗 口即 可 以是 本 进 程 内 的 ，也 可 以是 由 其 他 进 程 所 创 建 的 。在 特 定 的消 息 发
出 ，并 在到达 目的窗 口之前 ，钩子程 序先行截获此 消息并得
ｗｉｈ ｔ ｅ Ｒ ｅ ｏ ｅ Ｈ ｏ ｋ Ｔｅ ｈｎ ｌ ｇ ｎ ｔ ｔ ｈ ｍ ｔ ｏ ｃ ｏ ｏ ｙ ｉ ｈｅ ＶＢ ｏ ｒ ｍ ｍ ｉ Ｐｒ ｇ ａ ｎｇ
ＺＨＡＮＧ Ｊ ｎ ｉｇ
（ ｃ ｏ ｌ ｆＭ ｅ ｈ ｎｃ ｌ ｅ ｔ ｎｃ＆ Ｉｆｒ ｔ ｎ Ｅ ｇｎ ｅ Ｈｅａ ｉｅｓ ｙ， ｙ ｎ ａ ｅ ０ ５ ０ ） Ｓ ｈ ｏ ｃ ａ ｉａ ｃｒ ｉ ｏ Ｅｌ ｏ ｎｏｍａｉ ｎ ｉｅ ｒ， ｔｏＵｎｖ ｒｉ Ｂａ ａ ｎ ｏ ｒ １ ０ Ｏ ｏ ｔ
任 何 一 个 钩 子都 有 一 个 由 系 统 来 维 护 的 指 针 列 表 （ 子 钩
“ 隐藏 键”后面的下拉式组合列 表中选择隐藏程 序时 的按键 ， 在 “ 显示键”后 的下拉式 组合列表 中选 择要显示 已被隐藏程
序 的按 键 ，单 击 “ 置 ”命 令 按 钮 完 成 设 置 ，可 以单 击 “ 设 隐
链表） ，其指针指 向钩子的各个处 理函数。最近安装的钩子放
[最新]vb6全局键盘、鼠标钩子
![[最新]vb6全局键盘、鼠标钩子](https://img.taocdn.com/s3/m/6febd5e39f3143323968011ca300a6c30c22f1e1.png)
VB6全局键盘、鼠标钩子VB: 全局键盘、鼠标钩子'---------------------------------'Form'安装钩子Private sub AddHook()'键盘钩子lHook(0) = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)'鼠标钩子lHook(1) = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)End Sub'卸钩子Private sub DelHook()UnhookWindowsHookEx lHook(0)UnhookWindowsHookEx lHook(1)End Sub'---------------------------------'模块Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As LongPublic Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As LongPublic Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As IntegerPublic Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As LongPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)Public Type KEYMSGSvKey As Long '虚拟码 (and &HFF)sKey As Long '扫描码flag As Long '键按下：128 抬起：0time As Long 'Window运行时间End TypePublic Type MOUSEMSGSX As Long 'x座标Y As Long 'y座标a As Longb As Longtime As Long 'Window运行时间End TypePublic Type POINTAPIX As LongY As LongEnd TypePublic Const WH_KEYBOARD_LL = 13Public Const WH_MOUSE_LL = 14Public Const Alt_Down = &H20'-----------------------------------------'消息Public Const HC_ACTION = 0Public Const HC_SYSMODALOFF = 5Public Const HC_SYSMODALON = 4'键盘消息Public Const WM_KEYDOWN = &H100Public Const WM_KEYUP = &H101Public Const WM_SYSKEYDOWN = &H104Public Const WM_SYSKEYUP = &H105'鼠标消息Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_LBUTTONDBLCLK = &H203Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Public Const WM_RBUTTONDBLCLK = &H206Public Const WM_MBUTTONDOWN = &H207Public Const WM_MBUTTONUP = &H208Public Const WM_MBUTTONDBLCLK = &H209Public Const WM_MOUSEACTIVATE = &H21Public Const WM_MOUSEFIRST = &H200Public Const WM_MOUSELAST = &H209Public Const WM_MOUSEWHEEL = &H20APublic Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic strKeyName As String * 255Public Declare Function GetActiveWindow Lib "user32" () As LongPublic keyMsg As KEYMSGSPublic MouseMsg As MOUSEMSGSPublic lHook(1) As Long'----------------------------------------'模拟鼠标Private Const MOUSEEVENTF_LEFTDOWN = &H2Private Const MOUSEEVENTF_LEFTUP = &H4Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute movePrivate Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long'--------------------------------------'模拟按键Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)'鼠标钩子Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim pt As POINTAPIIf code = HC_ACTION ThenCopyMemory MouseMsg, lParam, LenB(MouseMsg)Form1.txtMsg(1).Text = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y)Form1.txtHwnd(1) = Format(wParam, "0")If wParam = WM_MBUTTONDOWN Then '把中键改为左键mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0CallMouseHookProc = 1End IfIf wParam = WM_MBUTTONUP Thenmouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0CallMouseHookProc = 1End IfEnd IfIf code <> 0 ThenCallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)End IfEnd Function'键盘钩子Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim lKey As LongDim strKeyName As String * 255Dim strLen As LongIf code = HC_ACTION ThenCopyMemory keyMsg, lParam, LenB(keyMsg)Select Case wParamCase WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP,WM_KEYUP:lKey = keyMsg.sKey And &HFF '扫描码lKey = lKey * 65536strLen = GetKeyNameText(lKey, strKeyName, 250)Form1.txtMsg(0).Text = "键名:" + Left(strKeyName, strLen) + " 虚拟码:" + Format(keyMsg.vKey And &HFF, "0") + " 扫描码:" + Format(lKey / 65536, "0")Form1.txtHwnd(0) = ""If (GetKeyState(vbKeyControl) And &H8000) ThenForm1.txtHwnd(0) = Form1.txtHwnd(0) + "Ctrl " End IfIf (keyMsg.flag And Alt_Down) <> 0 ThenForm1.txtHwnd(0) = Form1.txtHwnd(0) + "Alt " End IfIf (GetKeyState(vbKeyShift) And &H8000) ThenForm1.txtHwnd(0) = Form1.txtHwnd(0) + "Shift" End If'keyMsg.vKey And &HFF 虚拟码'lKey / 65536 扫描码If (keyMsg.vKey And &HFF) = vbKeyY Then '把Y键替换为NIf wParam = WM_SYSKEYDOWN Or wParam =WM_KEYDOWN Thenkeybd_event vbKeyN, 0, 0, 0End IfCallKeyHookProc = 1 '屏蔽按键End IfEnd SelectEnd IfIf code <> 0 ThenCallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)End IfEnd Function=========================================================== ========。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
用VB实现的全局键盘钩子2010-04-06 13:30代码功能：实时监测Caps Lock、NumLock、Scroll Lock三个按件的状态，并显示在Label1 Label2 Label3三个标签中'.bas模块中Public m_hDllKbdHook As Long 'public variable holding'the handle to the hook procedurePublic Const WH_KEYBOARD_LL As Long = 13 'enables monitoring of keyboard 'input events about to be posted 'in a thread input queuePrivate Const HC_ACTION As Long = 0 'wParam and lParam parameters'contain information about a'keyboard messagePublic Const VK_CAPITAL As Long = &H14Public Const VK_NUMLOCK As Long = &H90Public Const VK_SCROLL As Long = &H91Private Const LLKHF_UP As Long = &H80& 'test the transition-state flagPublic Type KeyboardByteskbByte(0 To 255) As ByteEnd TypePrivate Type KBDLLHOOKSTRUCTvkCode As Long 'a virtual-key code in the range 1 to 254 scanCode As Long 'hardware scan code for the keyflags As Long 'specifies the extended-key flag,'event-injected flag, context code,'and transition-state flagtime As Long 'time stamp for this messagedwExtraInfo As Long 'extra info associated with the messageEnd TypePublic Declare Function SetWindowsHookEx Lib "user32" _Alias "SetWindowsHookExA" _(ByVal idHook As Long, _ByVal lpfn As Long, _ByVal hmod As Long, _ByVal dwThreadId As Long) As LongPublic Declare Function UnhookWindowsHookEx Lib "user32" _(ByVal hHook As Long) As LongPublic Declare Function CallNextHookEx Lib "user32" _(ByVal hHook As Long, _ByVal nCode As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongPublic Declare Sub CopyMemory Lib "kernel32" _Alias "RtlMoveMemory" _(pDest As Any, _pSource As Any, _ByVal cb As Long)Public Declare Function GetKeyboardState Lib "user32" _(kbArray As KeyboardBytes) As LongPublic Declare Function GetKeyState Lib "user32" _(ByVal nVirtKey As Long) As IntegerPublic Function LowLevelKeyboardProc(ByVal nCode As Long, _ByVal wParam As Long, _ByVal lParam As Long) As Long Dim kbdllhs As KBDLLHOOKSTRUCTIf nCode = HC_ACTION ThenCall CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))If (kbdllhs.flags And LLKHF_UP) ThenSelect Case kbdllhs.vkCodeCase VK_NUMLOCKbel1.Visible = (GetKeyState(VK_NUMLOCK) = &HFF81)Case VK_CAPITALbel2.Visible = (GetKeyState(VK_CAPITAL) = &HFF81)Case VK_SCROLLbel3.Visible = (GetKeyState(VK_SCROLL) = &HFF81)Case ElseEnd SelectEnd IfEnd If 'nCode = HC_ACTIONLowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _nCode, _wParam, _lParam)End FunctionForm1中加入3个标签控件Label1、Label2、Label3Form1中的代码Private Sub Form_Load()Dim kbdState As KeyboardBytesCall GetKeyboardState(kbdState)With Label1.Caption = "Numlock is ON".Alignment = vbRightJustifyEnd WithWith Label2.Caption = "Caps lock is ON".Alignment = vbRightJustifyEnd WithWith Label3.Caption = "Scroll lock is ON".Alignment = vbRightJustifyEnd WithLabel1.Visible = kbdState.kbByte(VK_NUMLOCK) = 1Label2.Visible = kbdState.kbByte(VK_CAPITAL) = 1Label3.Visible = kbdState.kbByte(VK_SCROLL) = 1'set and obtain the handle to the keyboard hookm_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _AddressOf LowLevelKeyboardProc, _ App.hInstance, _0&)If m_hDllKbdHook = 0 ThenMsgBox "Failed to install low-level keyboard hook."End IfEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)If m_hDllKbdHook <> 0 ThenCall UnhookWindowsHookEx(m_hDllKbdHook)End IfEnd Sub'还有一段可以禁用Ctrl+Esc Alt + Esc Alt+Tab三组热键的Private Const WH_KEYBOARD_LL = 13& 'enables monitoring of keyboard 'input events about to be posted 'in a thread input queuePrivate Const HC_ACTION = 0& 'wParam and lParam parameters 'contain information about a'keyboard messagePrivate Const LLKHF_EXTENDED = &H1& 'test the extended-key flag Private Const LLKHF_INJECTED = &H10& 'test the event-injected flag Private Const LLKHF_ALTDOWN = &H20& 'test the context codePrivate Const LLKHF_UP = &H80& 'test the transition-state flag Private Const VK_TAB = &H9 'virtual key constantsPrivate Const VK_CONTROL = &H11Private Const VK_ESCAPE = &H1BPrivate Type KBDLLHOOKSTRUCTvkCode As Long 'a virtual-key code in the range 1 to 254 scanCode As Long 'hardware scan code for the keyflags As Long 'specifies the extended-key flag,'event-injected flag, context code,'and transition-state flagtime As Long 'time stamp for this messagedwExtraInfo As Long 'extra info associated with the messageEnd TypePrivate Declare Function SetWindowsHookEx Lib "user32" _Alias "SetWindowsHookExA" _(ByVal idHook As Long, _ByVal lpfn As Long, _ByVal hmod As Long, _ByVal dwThreadId As Long) As LongPrivate Declare Function UnhookWindowsHookEx Lib "user32" _(ByVal hHook As Long) As LongPrivate Declare Function CallNextHookEx Lib "user32" _(ByVal hHook As Long, _ByVal nCode As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _Alias "RtlMoveMemory" _(pDest As Any, _pSource As Any, _ByVal cb As Long)Private Declare Function GetAsyncKeyState Lib "user32" _(ByVal vKey As Long) As IntegerPrivate m_hDllKbdHook As Long 'private variable holding'the handle to the hook procedure Public Sub Main()'set and obtain the handle to the keyboard hookm_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _AddressOf LowLevelKeyboardProc, _ App.hInstance, _0&)If m_hDllKbdHook <> 0 ThenMsgBox "Ctrl+Esc, Alt+Tab and Alt+Esc are blocked. " & _"Click OK to quit and re-enable the keys.", _vbOKOnly Or vbInformation, _"Keyboard Hook Active"Call UnhookWindowsHookEx(m_hDllKbdHook)ElseMsgBox "Failed to install low-level keyboard hook - " & stDllErrorEnd IfEnd SubPublic Function LowLevelKeyboardProc(ByVal nCode As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongStatic kbdllhs As KBDLLHOOKSTRUCTIf nCode = HC_ACTION ThenCall CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))'Ctrl+Esc --------------If (kbdllhs.vkCode = VK_ESCAPE) And _CBool(GetAsyncKeyState(VK_CONTROL) _And &H8000) ThenDebug.Print "Ctrl+Esc blocked"LowLevelKeyboardProc = 1Exit FunctionEnd If 'kbdllhs.vkCode = VK_ESCAPE'Alt+Tab --------------If (kbdllhs.vkCode = VK_TAB) And _CBool(kbdllhs.flags And _LLKHF_ALTDOWN) ThenDebug.Print "Alt+Tab blocked"LowLevelKeyboardProc = 1Exit FunctionEnd If 'kbdllhs.vkCode = VK_TAB'Alt+Esc --------------If (kbdllhs.vkCode = VK_ESCAPE) And _CBool(kbdllhs.flags And _LLKHF_ALTDOWN) ThenDebug.Print "Alt+Esc blocked"LowLevelKeyboardProc = 1Exit FunctionEnd If 'kbdllhs.vkCode = VK_ESCAPEEnd If 'nCode = HC_ACTIONLowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _ nCode, _wParam, _lParam)End Function。