Windows勾子处理类Thook 以及示例
我已经看到了很多人想在一个应用程序中挂接消息搞一个干净的解决方案。所以,前一段时间作我决定写一个钩子类,能很好的处理事件之类的东西。
Hook.pas可以分配方法的指针指向一个过程(有一些汇编的帮助)。
例如:如果你想在应用程序中捕获所有击键 - 只需声明一个TKeyboardHook实例,指派一个处理程序给OnPreExecute或OnPostExecute,或同时处理这两个事件。设置激活你的KeyboadHook(KeyboardHook.Active:= true)然后你就可以出去等他运行了..
Windows的钩子
下面是Windows API指南中钩子的说明:
一个钩子是系统消息处理机制的指针,应用程序可以安装一个子程序,监测系统中到达目标窗口过程的消息的和某些类型的信息流量。
简单的说,挂钩是一个函数,你可以创建一个DLL或您的应用程序的一部分来监视Windows操作系统内部运做。
想法就是写一个函数,Windows发生某些事件时可以调用 - 例如,当用户按下键盘上的键或移动鼠标。
为了更深入介绍钩子,看看 Windows钩子以及如何在Delphi应用程序使用它们。
挂钩机制依赖于Windows消息和回调函数。
挂钩类型
不同的钩子类型使应用程序能够监视系统的不同信息。
例如:
您可以使用WH_KEYBOARD钩子监视键盘输入发送的消息队列;
您可以使用WH_MOUSE钩子子监视鼠标输入发送的消息队列;
您可以用WH_SHELL钩子处理Shell程序应用程序即将被激活、当顶层窗口创建或销毁。
Hooks.pas
该hooks.pas单位定义了几个钩子类型:
TCBTHook - 在窗口激活,创建,销毁,最小化,最大化,移动或调整大小之前调用,完成一个系统命令之前,从系统消息队列中删除鼠标或键盘事件之前,设置输入焦点之前;或与前同步系统消息队列之前也会调用。
TDebugHook - 在调用系统中其他钩子设置的过程之前调用
TGetMessageHook - 使应用程序能够监视即将被GetMessage或者PeekMessage函数返回的消息
TJournalPlaybackHook -应用程序能够在系统消息队列中插入消息。
TJournalRecordHook - 让您能够监视和记录输入事件(使用WH_JOURNALPLAYBACK钩子记录鼠标和键盘事件的顺序以便后来重现)。
TKeyboardHook - 让应用程序可以监视WM_KEYDOWN和WM_KEYUP消息流量。
TMouseHook - 让您能监视即将被GetMessage或者PeekMessage函数返回的鼠标消息。
TLowLevelKeyboardHook - 允许您监视即将送到一个线程输入队列的键盘输入事件。
TLowLevelMouseHook - 允许您监视即将送到一个线程输入队列的鼠标输入事件。
TKeyboardHook例子
这里有一个演示应用程序的键盘钩子的部分代码,向你展示你如何使用hooks.pas:
uses hooks, ....
var
KeyboardHook: TKeyboardHook;
....
//MainForm's OnCreate event handler
procedure TMainForm.FormCreate(Sender: TObject) ;
begin
KeyboardHook := TKeyboardHook.Create;
KeyboardHook.OnPreExecute := KeyboardHookPREExecute;
KeyboardHook.Active := True;
end;
//handles KeyboardHook's OnPREExecute
procedure TMainForm.KeyboardHookPREExecute(Hook: THook; var Hookmsg: THookMsg) ;
var
Key: Word;
begin
//Here you can choose if you want to return
//the key stroke to the application or not
Hookmsg.Result := IfThen(cbEatKeyStrokes.Checked, 1, 0) ;
Key := Hookmsg.WPARAM;
Caption := Char(key) ;
end;
{
*****************************************************************************
* *
* Hooks *
* *
* By Jens Borrisholt *
* Jens@Borrisholt.com *
* *
* This file may be distributed and/or modified under the terms of the GNU *
* General Public License (GPL) version 2 as published by the Free Software *
* Foundation. *
* *
* This file has no warranty and is used at the users own peril *
* *
* Please report any bugs to Jens@Borrisholt.com or contact me if you want *
* to contribute to this unit. It will be deemed a breach of copyright if *
* you publish any source code (modified or not) herein under your own name *
* without the authors consent!!!!! *
* *
* CONTRIBUTIONS:- *
* Jens Borrisholt (Jens@Borrisholt.com) [ORIGINAL AUTHOR] *
* *
* Published: http://delphi.about.com/od/windowsshellapi/a/delphi-hooks.htm *
*****************************************************************************
}
unit hooks;
interface
uses
Windows, Classes;
const
WH_KEYBOARD_LL = 13;
WH_MOUSE_LL = 14;
(*
* Low level hook flags
*)
LLKHF_EXTENDED = $01;
LLKHF_INJECTED = $10;
LLKHF_ALTDOWN = $20;
LLKHF_UP = $80;
{$M+}
type
TKeyState = (ksKeyDown, ksKeyIsDown, ksDummy, ksKeyUp);
THookMsg = packed record
Code: Integer;
WParam: WPARAM;
LParam: LPARAM;
Result: LResult
end;
ULONG_PTR = ^DWORD;
pKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
KBDLLHOOKSTRUCT = packed record
vkCode: DWORD;
scanCodem: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: ULONG_PTR;
end;
pMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
MSLLHOOKSTRUCT = packed record
Pt: TPoint;
MouseData: DWORD;
Flags: DWORD;
Time: DWORD;
dwExtraInfo: ULONG_PTR;
end;
TCustomHook = class;
THook = class;
THookMethod = procedure(var HookMsg: THookMsg) of object;
THookNotify = procedure(Hook: THook; var Hookmsg: THookMsg) of object;
TCustomHook = class
private
FHook: hHook;
FHookProc: Pointer;
FOnPreExecute: THookNotify;
FOnPostExecute: THookNotify;
FActive: Boolean;
FLoadedActive: Boolean;
FThreadID: Integer;
procedure SetActive(NewState: Boolean);
procedure SetThreadID(NewID: Integer);
procedure HookProc(var HookMsg: THookMsg);
protected
procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); virtual;
procedure PostExecute(var HookMsg: THookMsg); virtual;
function AllocateHook: hHook; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
property ThreadID: Integer read FThreadID write SetThreadID stored False;
property Active: Boolean read FActive write SetActive;
property OnPreExecute: THookNotify read FOnPreExecute write FOnPreExecute;
property OnPostExecute: THookNotify read FOnPostExecute write FOnPostExecute;
end;
THook = class(TCustomHook)
published
property Active;
property OnPreExecute;
property OnPostExecute;
end;
TCallWndProcHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TCallWndProcRetHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TCBTHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TDebugHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TGetMessageHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TJournalPlaybackHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TJournalRecordHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TKeyboardHook = class(THook)
private
FKeyState: TKeyState;
protected
procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
procedure PostExecute(var HookMsg: THookMsg); override;
public
function AllocateHook: hHook; override;
published
property KeyState : TKeyState read FKeyState;
end;
TMouseHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TMsgHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TShellHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TSysMsgHook = class(THook)
public
function AllocateHook: hHook; override;
end;
TLowLevelKeyboardHook = class(THook)
private
FHookStruct: pKBDLLHOOKSTRUCT;
protected
procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
procedure PostExecute(var HookMsg: THookMsg); override;
public
function AllocateHook: hHook; override;
property HookStruct: pKBDLLHOOKSTRUCT read FHookStruct;
end;
TLowLevelMouseHook = class(THook)
private
FHookStruct: pMSLLHOOKSTRUCT;
protected
procedure PreExecute(var HookMsg: THookMsg; var Handled: Boolean); override;
procedure PostExecute(var HookMsg: THookMsg); override;
public
function AllocateHook: hHook; override;
property HookStruct: pMSLLHOOKSTRUCT read FHookStruct;
end;
function MakeHookInstance(Method: THookMethod): Pointer;
procedure FreeHookInstance(ObjectInstance: Pointer);
implementation
uses
SysUtils;
const
InstanceCount = 313; // set so that sizeof (TInstanceBlock) < PageSize
type
pObjectInstance = ^TObjectInstance;
TObjectInstance = packed record
Code: Byte;
Offset: Integer;
case Integer of
0: (Next: pObjectInstance);
1: (Method: THookMethod);
end;
pInstanceBlock = ^TInstanceBlock;
TInstanceBlock = packed record
Next: pInstanceBlock;
Code: array[1..2] of Byte;
WndProcPtr: Pointer;
Instances: array[0..InstanceCount] of TObjectInstance;
end;
var
InstBlockList: pInstanceBlock = nil;
InstFreeList: pObjectInstance = nil;
function StdHookProc(Code, WParam: WPARAM; LParam: LPARAM): LResult; stdcall; assembler;
asm
XOR EAX,EAX
PUSH EAX
PUSH LParam
PUSH WParam
PUSH Code
MOV EDX,ESP
MOV EAX,[ECX].Longint[4]
CALL [ECX].Pointer
ADD ESP,12
POP EAX
end;
{ Allocate a hook method instance }
function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
Result := Longint(Dest) - (Longint(Src) + 5);
end;
function MakeHookInstance(Method: THookMethod): Pointer;
const
BlockCode: array[1..2] of Byte = ($59, $E9);
PageSize = 4096;
var
Block: pInstanceBlock;
Instance: pObjectInstance;
begin
if InstFreeList = nil then
begin
Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
Block^.Next := InstBlockList;
Move(BlockCode, Block^.Code, SizeOf(BlockCode));
Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));
Instance := @Block^.Instances;
repeat
Instance^.Code := $E8;
Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
Instance^.Next := InstFreeList;
InstFreeList := Instance;
Inc(Longint(Instance), SizeOf(TObjectInstance));
until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
InstBlockList := Block
end;
Result := InstFreeList;
Instance := InstFreeList;
InstFreeList := Instance^.Next;
Instance^.Method := Method
end;
{ Free a hook method instance }
procedure FreeHookInstance(ObjectInstance: Pointer);
begin
if ObjectInstance = nil then
Exit;
pObjectInstance(ObjectInstance)^.Next := InstFreeList;
InstFreeList := ObjectInstance
end;
constructor TCustomHook.Create;
begin
inherited;
FHookProc := MakeHookInstance(HookProc);
FActive := False;
FLoadedActive := False;
FHook := 0;
ThreadID := GetCurrentThreadID;
end;
destructor TCustomHook.Destroy;
begin
Active := False;
FreeHookInstance(FHookProc);
inherited;
end;
procedure TCustomHook.SetActive(NewState: Boolean);
begin
if FActive = NewState then
Exit;
FActive := NewState;
case Active of
True:
begin
FHook := AllocateHook;
if (FHook = 0) then
begin
FActive := False;
raise Exception.Create(Classname + ' CREATION FAILED!');
end;
end;
False:
begin
if (FHook <> 0) then
UnhookWindowsHookEx(FHook);
FHook := 0;
end;
end;
end;
procedure TCustomHook.SetThreadID(NewID: Integer);
var
IsActive: Boolean;
begin
IsActive := FActive;
Active := False;
FThreadID := NewID;
Active := IsActive;
end;
procedure TCustomHook.HookProc(var HookMsg: THookMsg);
var
Handled: Boolean;
begin
Handled := False;
PreExecute(HookMsg, Handled);
if not Handled then
begin
with HookMsg do
Result := CallNextHookEx(FHook, Code, wParam, lParam);
PostExecute(HookMsg);
end;
end;
procedure TCustomHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
if Assigned(FOnPreExecute) then
FOnPreExecute(THook(Self), HookMsg);
Handled := HookMsg.Result <> 0;
end;
procedure TCustomHook.PostExecute(var HookMsg: THookMsg);
begin
if Assigned(FOnPostExecute) then
FOnPostExecute(THook(Self), HookMsg);
end;
function TCallWndProcHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_CALLWNDPROC, FHookProc, HInstance, ThreadID);
end;
function TCallWndProcRetHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, hInstance, ThreadID);
end;
function TCBTHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_CBT, FHookProc, hInstance, ThreadID);
end;
function TDebugHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_DEBUG, FHookProc, hInstance, ThreadID);
end;
function TGetMessageHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_GETMESSAGE, FHookProc, hInstance, ThreadID);
end;
function TJournalPlaybackHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_JOURNALPLAYBACK, FHookProc, hInstance, ThreadID);
end;
function TJournalRecordHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_JOURNALRECORD, FHookProc, hInstance, ThreadID);
end;
function TKeyboardHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_KEYBOARD, FHookProc, hInstance, ThreadID);
end;
function TMouseHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_MOUSE, FHookProc, hInstance, ThreadID);
end;
function TMsgHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_MSGFILTER, FHookProc, hInstance, ThreadID);
end;
function TShellHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_SHELL, FHookProc, hInstance, ThreadID);
end;
function TSysMsgHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_SYSMSGFILTER, FHookProc, hInstance, ThreadID);
end;
function TLowLevelKeyboardHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_KEYBOARD_LL, FHookProc, hInstance, 0);
end;
procedure TLowLevelKeyboardHook.PostExecute(var HookMsg: THookMsg);
begin
inherited;
FHookStruct := nil;
end;
procedure TLowLevelKeyboardHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
FHookStruct := pKBDLLHOOKSTRUCT(Hookmsg.LPARAM);
inherited;
end;
{ TLowLevelMouseHook }
function TLowLevelMouseHook.AllocateHook: hHook;
begin
Result := SetWindowsHookEx(WH_MOUSE_LL, FHookProc, hInstance, 0);
end;
procedure TLowLevelMouseHook.PostExecute(var HookMsg: THookMsg);
begin
inherited;
FHookStruct := nil;
end;
procedure TLowLevelMouseHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
FHookStruct := pMSLLHOOKSTRUCT(Hookmsg.LPARAM);
inherited;
end;
procedure TKeyboardHook.PostExecute(var HookMsg: THookMsg);
begin
inherited;
FKeyState := ksDummy;
end;
procedure TKeyboardHook.PreExecute(var HookMsg: THookMsg; var Handled: Boolean);
begin
FKeyState := TKeyState(Hookmsg.lParam shr 30);
inherited;
end;
end.
转载于:https://www.cnblogs.com/hnxxcxg/archive/2011/04/23/2940608.html
Windows勾子处理类Thook 以及示例相关推荐
- 支持向量机python代码_用TensorFlow实现多类支持向量机的示例代码
这篇文章主要介绍了用TensorFlow实现多类支持向量机的示例代码,现在分享给大家,也给大家做个参考.一起过来看看吧 本文将详细展示一个多类支持向量机分类器训练iris数据集来分类三种花. SVM算 ...
- 第七章:无模式对话框 和 Windows通用对话框类
第七章:无模式对话框 和 Windows通用对话框类 1,[无模式对话框]在它处于激活状态下还允许用户在(同一个应用程序中)其它地方工作. [通用对话框]则是C++和一组Windows的实用对话框之间 ...
- aspx mysql类_aspx中的mysql操作类sqldatasource使用示例分享
复制代码 代码如下: /p> "http://www.w3.org/TR/xhtmlll/DTD/xhtmlll.dtd"> asp.net to mysql asp. ...
- wxWidgets:显示 wxDebugReport 和相关类的最小示例
wxWidgets:显示 wxDebugReport 和相关类的最小示例 wxWidgets:显示 wxDebugReport 和相关类的最小示例 wxWidgets:显示 wxDebugReport ...
- DCMTK:类DVPSIPCClient的示例消息服务器
DCMTK:类DVPSIPCClient的示例消息服务器 类DVPSIPCClient的示例消息服务器 类DVPSIPCClient的示例消息服务器 #include "dcmtk/conf ...
- php rss xml,php 一个完全面向对象的RSS/XML类的简单示例
这篇文章主要为大家详细介绍了php 一个完全面向对象的RSS/XML类的简单示例,具有一定的参考价值,可以用来参考一下. 感兴趣的小伙伴,下面一起跟随512笔记的小编罗X来看看吧. 经测试代码如下: ...
- php数值操作,php数值计算num类简单操作示例
php数值计算num类简单操作示例,在线,计算器,小数,整数,程序设计 php数值计算num类简单操作示例 易采站长站,站长之家为您整理了php数值计算num类简单操作示例的相关内容. 本文实例讲述了 ...
- php分页类示例下载,PHP 通用分页类的简单示例
这篇文章主要为大家详细介绍了PHP 通用分页类的简单示例,具有一定的参考价值,可以用来参考一下.对PHP通用分页类感兴趣的小伙伴,下面一起跟随512笔记的小编两巴掌来看看吧! 写了个php的通用分页类 ...
- (36)System Verilog类中方法示例
(36)System Verilog类中方法示例 1.1 目录 1)目录 2)FPGA简介 3)System Verilog简介 4)System Verilog类中方法示例 5)结语 1.2 FPG ...
最新文章
- [转]Knockoutjs快速入门
- 读懂这一篇,集群节点不下线
- java 获取手机归属地_java 获取手机归属地
- 前端学习(1798):前端调试之css伪元素练习
- clion卸载+clion连接docker编写trt程序
- 手机端答题页面_有奖答题来啦!科普知识等你来挑战……
- 本地上传文件至Linux虚拟机报错“复制时发生出错“
- SVN报错The working copy needs to be upgraded
- 韦东山ARM裸机学习笔记——S3C2440的串口驱动编程原理
- [Vulfocus解题系列] 所复现漏洞总结
- 【Nunit入门系列讲座 1】Nunit的安装及功能介绍
- 计算机的程序代码是储存在什么中的,计算机的一切程序和数据都是以什么情势贮存?...
- matlab中牛顿下山法实例,非线性方程的数值解法牛顿下山法matlab
- 4-6 ElasticSearch
- ArcGIS教程:创建饼图
- Java 中 == 与 equals 区别,再确认一遍?
- 白领做全身体操可有效防治鼠标手
- Learning Calibrated Medical Image Segmentation via Multi-rater Agreement Modeling
- 【文末送书】今年应届算法工程师的薪酬,看了作何感想?
- 数值分析实验二 解线性方程组
热门文章
- 数据大屏产品介绍PPT_有这些图表美化工具,十分钟配出炫酷的数据可视化大屏...
- IIS下配置php运行环境
- java 面试心得总结-BAT、网易
- knn实战:如何对手写数字进行识别?
- 如果只看一篇文章弄懂Pfile与spfile,那么这篇就够了……
- Spark RDD使用详解4--Key-Value型Transformation算子
- (转)gLFlush()和gLFinish()
- Iterator 和 for...of 循环
- ES6 generator
- docker image 实践之容器化 ganglia