VB6全局键盘、鼠标钩子
基于VB的键盘钩子算法的实现

输入 的运作 ,然 后根据 虚拟键 表判断 按键 的类 型 , 最 后把 得到的准 确的按键类 型输 出。
21 键 盘 工作 流 程 图 ( 1 . 图 )
少 的一 部分 在使 用计算机 进行操 作的 时候 , 经常会 使用 到一些快捷 的操作方 式或获取 键盘 的按键 信息 . 例 如使用 快捷 键来实 现复 制 、粘 贴或 是否 按 了 E c s、
2 键 盘 模 块 ( 2 . 3 图 )
机 息 . 可以强制结 束消息 的传递 。 还 总 2 键 盘 钩 子 的 工作 原 理 第
三
一
3 键 盘 钩 子 实现 算 法
使 用 不 同 的 W idw P 函 数 获 取 键 盘 的 动 作 n o sA I
固
9 1 6
簟 麓纛 蠢
T b 键 a Si t hf 键
vK y sae b e e c p v Ky  ̄ e be H vKy be
vKy rn b eP i t vK y b 2 6 5 9 7
空 格 键 等 操 作 信 息 。 捷 键 具 有 操 作 简单 、 便 、 捷 快 方 快 等优 点 . 就 需 要 我 们 在 编 写 程 序 代 码 的 过 程 中增 加 这 对 键 盘 的 按 键 进 行 判 断 . 个 过 程 就 是 所 谓 的 键 盘 钩 这 子 功 能 利 用 V 在 B来 编 写 所 需 要 的 应 用 程 序 时 . 于 由 V B无 法 直 接 对 系 统 的 注 册 表 进 行 操 作 对 于 此 类 操
图 1 键 盘 工 作 流程 图
22 键 盘的虚拟键 简表 ( 1 . 表 )
在 表 1中 . 一 列 是 系 统 各 个 键 中 的 名 称 . 二 第 第
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实现的全局键盘钩子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程序设计课件第17讲 鼠标、键盘

Sub Form1_MouseDown(Sender As Object, e As ……)…… MouseUp: MouseUp:释放某一鼠标键 MouseMove: MouseMove:移动鼠标
2
对象 e
3
• e.X 和 e.Y :
鼠标的当前位置
例 显示鼠标指针所指位置
4
2. 键盘事件
Form1_KeyPress(Sender As Object, e As ……) e.KeyChar:按键的ASCII码 e.KeyChar:按键的ASCII码 ASCII e.Handled: e.Handled:是否响应本次按键操作 True: True:不响应 例:文本框的输入效应 False: False:响应
6
False: False:响应
区别
KeyPress 事件发生的时间 参数值 按Shift+A时 Shift+A时 事件发生的次数 按Shift+A时参数 Shift+A时参数 键盘大写状态) (键盘大写状态) 按Shift+a时参数 Shift+a时参数 键盘小写状态) (键盘小写状态) 按一ASCII键 按一ASCII键 ASCII e.KeyChar接收到 e.KeyChar接收到 ASCII值 ASCII值 事件发生一次 97 65 KeyDown和 KeyDown和KeyUp 按任意一个键 e.KeyCode接收到 e.KeyCode接收到 键的扫描码 事件发生两次 第一次是16 第一次是16 第二次是65 第二次是65 第一次是16 第一次是16 第二次是65 第二次是65
e.Button 操作左键 操作右键 操作中键 没按键 MouseButtons.Left MouseButtons.Right MouseButtons.Middle MouseButtons.None
Vb6记录鼠标及回放

Vb6记录鼠标及回放很多的教学软件或系统监视软件可以自动记录回放用户的输入文字或点击按钮等操作操作,这个功能的实现是使用了Windows的Hook函数。
本文介绍如何通过使用VB来实现鼠标键盘操作的纪录和回放。
Windows提供API函数SetwindowsHookEx来建立一个Hook,通过这个函数可以将一个程序添加到Hook链中监视Windows 消息,函数语法为: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其中参数idHook指定建立的监视函数类型。
通过Windows MSDN帮助可以看到,SetwindowsHookEx函数提供15种不同的消息监视类型,在这里我们将使用WH_JOURNALRECORD和WH_JOURNALPLAYBACK来监视键盘和鼠标操作。
参数lpfn指定消息函数,在相应的消息产生后,系统会调用该函数并将消息值传递给该函数供处理。
函数的一般形式为:Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM ): LRESULT stdcall;其中code为系统指示标记,wParam和lParam为附加参数,根据不同的消息监视类型而不同。
只要在程序中建立这样一个函数再通过SetwindowsHookEx函数将它加入到消息监视链中就可以处理消息了。
在不需要监视系统消息时需要调用提供UnHookWindowsHookEx来解除对消息的监视。
WH_JOURNALRECORD和WH_JOURNALPLAYBACK类型是两种相反的Hook类型,前者获得鼠标、键盘动作消息,后者回放鼠标键盘消息。
用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中使用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,就可以用它来访问键盘输入了。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
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 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 'ÐéÄâÂë (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 Long Public 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, ByValdwExtraInfo As Long)Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd AsLong, lpPoint As POINTAPI) As Long'--------------------------------------'Ä£Äâ°´¼üPrivate Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByValbScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)'Êó±ê¹³×Ó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 '°ÑÖмü¸ÄΪ×ó¼ü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 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) + " ÐéÄâÂë:" + 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¼üÌæ»»ÎªN 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================================================================== =。