(okwary) 小叹的学习园地

与天斗?不够高~ 与地斗?不够阔 与人斗? 脸皮不够厚

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

 

来源:万一的 Delphi 博客

 

WinAPI: SetWindowsHookEx - 设置钩子

 

提示: 如果要设置系统级钩子, 钩子函数必须在 DLL 中.

SetWindowsHookEx(
  idHook: Integer;   {钩子类型}
  lpfn: TFNHookProc; {函数指针}
  hmod: HINST;       {包含钩子函数的模块(EXE、DLL)句柄; 一般是 HInstance; 如果是当前线程这里可以是 0}
  dwThreadId: DWORD  {关联的线程; 可用 GetCurrentThreadId 获取当前线程; 0 表示是系统级钩子}
): HHOOK;            {返回钩子的句柄; 0 表示失败}

//钩子类型 idHook 选项:
WH_MSGFILTER       = -1; {线程级; 截获用户与控件交互的消息}
WH_JOURNALRECORD   = 0;  {系统级; 记录所有消息队列从消息队列送出的输入消息, 在消息从队列中清除时发生; 可用于宏记录}
WH_JOURNALPLAYBACK = 1;  {系统级; 回放由 WH_JOURNALRECORD 记录的消息, 也就是将这些消息重新送入消息队列}
WH_KEYBOARD        = 2;  {系统级或线程级; 截获键盘消息}
WH_GETMESSAGE      = 3;  {系统级或线程级; 截获从消息队列送出的消息}
WH_CALLWNDPROC     = 4;  {系统级或线程级; 截获发送到目标窗口的消息, 在 SendMessage 调用时发生}
WH_CBT             = 5;  {系统级或线程级; 截获系统基本消息, 譬如: 窗口的创建、激活、关闭、最大最小化、移动等等}
WH_SYSMSGFILTER    = 6;  {系统级; 截获系统范围内用户与控件交互的消息}
WH_MOUSE           = 7;  {系统级或线程级; 截获鼠标消息}
WH_HARDWARE        = 8;  {系统级或线程级; 截获非标准硬件(非鼠标、键盘)的消息}
WH_DEBUG           = 9;  {系统级或线程级; 在其他钩子调用前调用, 用于调试钩子}
WH_SHELL           = 10; {系统级或线程级; 截获发向外壳应用程序的消息}
WH_FOREGROUNDIDLE  = 11; {系统级或线程级; 在程序前台线程空闲时调用}
WH_CALLWNDPROCRET  = 12; {系统级或线程级; 截获目标窗口处理完毕的消息, 在 SendMessage 调用后发生} 

 

WinAPI: UnhookWindowsHookEx - 卸掉钩子

UnhookWindowsHookEx(

  hhk: HHOOK {钩子句柄}

): BOOL;     {True/False}

 

WinAPI: CallNextHookEx - 调用下一个钩子

 

CallNextHookEx(
  hhk: HHOOK;     {当前钩子的句柄}
  nCode: Integer; {钩子代码; 就是给下一个钩子要交待的}
  wParam: WPARAM; {要传递的参数; 由钩子类型决定是什么参数}
  lParam: LPARAM  {要传递的参数; 由钩子类型决定是什么参数}
): LRESULT;       {会返回下一个钩子执行后的返回值; 0 表示失败}

//参数 nCode 的可选值:
HC_ACTION      = 0;     {}
HC_GETNEXT     = 1;     {}
HC_SKIP        = 2;     {}
HC_NOREMOVE    = 3;     {}
HC_NOREM = HC_NOREMOVE; {}
HC_SYSMODALON  = 4;     {}
HC_SYSMODALOFF = 5;     {}

 

 

 

目前对钩子的理解:
 
譬如我们用鼠标在某个窗口上双击了一次, 或者给某个窗口输入了一个字母 A; 首先发现这些事件的不是窗口, 而是系统!然后系统告诉窗口: 喂! 你让人点了, 并且是连续点了两鼠标, 你准备怎么办? 或者是系统告诉窗口: 喂! 有人向你家里扔砖头了, 不信你看看, 那块砖头是 A. 

这时窗口的对有些事件会忽略、对有些事件会做出反应:譬如, 可能对鼠标单击事件忽略, 窗口想: 你单击我不要紧, 累死你我不负责; 但一旦谁要双击我, 我会马上行动, 给你点颜色瞧瞧!这里窗口准备要采取的行动, 就是我们提前写好的事件.
用 Windows 的话说, 窗口的事件就是系统发送给窗口的消息; 窗口要采取的行动(事件代码)就是窗口的回调函数.但是! 往往隔墙有耳. 系统要通知给窗口的"话"(消息), 可能会被另一个家伙(譬如是一个贼)提前听到!有可能这个贼就是专门在这等情报的, 贼知道后, 往往在窗口知道以前就采取了行动!
并且这个贼对不同的消息会采取不同的行动方案, 它的行动方案一般也是早就准备好的;当然这个贼也不是对什么消息都感兴趣, 对不感兴趣的消息也就无须制定相应的行动方案.

总结: 这个"贼"就是我们要设置的钩子; "贼"的"行动方案"就是钩子函数, 或者叫钩子的回调函数.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

{声明键盘钩子回调函数; 其参数传递方式要用 API 的 stdcall}
function KeyHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  hook: HHOOK; {定义一个钩子句柄}

{实现键盘钩子回调函数}
function KeyHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  if (wParam = 65) then Beep; {每拦截到字母 A 会发声}
  Result := CallNextHookEx(hook, nCode, wParam, lParam);
end;

{设置键盘钩子}
procedure TForm1.FormCreate(Sender: TObject);
begin
  hook := SetWindowsHookEx(WH_KEYBOARD, @KeyHook, 0, GetCurrentThreadID);
end;

{释放键盘钩子}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnhookWindowsHookEx(hook);
end;

end.

尽管这个例子已经很简单了, 但还不足以让人明白彻底; 下面还得从更简单的开始.

 
钩子函数虽然不多, 但其参数复杂, 应该从参数入手才能深入进去.

UnhookWindowsHookEx 只需要 SetWindowsHookEx 返回的钩子句柄作参数, 这个简单;

先看看 SetWindowsHookEx 的声明:
SetWindowsHookEx(
  idHook: Integer;   {钩子类型}
  lpfn: TFNHookProc; {函数指针}
  hmod: HINST;       {包含钩子函数的模块(EXE、DLL)的句柄}
  dwThreadId: DWORD  {关联的线程}
): HHOOK;
第一个参数非常麻烦, 从后面说:

参数四 dwThreadId : 在设置全局钩子时这个参数一般是 0, 表示关联所有线程; 本例是线程级的钩子, 所以是
GetCurrentThreadId.

参数三 hmod: 是模块实例的句柄, 在 EXE 和 DLL 中都可以用 HInstance 得到当前实例的句柄; 直接用 API 也可以:
GetModuleHandle(nil).

参数二 lpfn: 是钩子函数的指针, 用 @ 和 Addr 函数都可以得到函数指针; 这里的关键是那个钩子函数:
首先不同的钩子类型对应着不同的钩子函数结构, Win32 共有 14 种钩子类型, 这是
详细注释;
本例用的是键盘钩子, 键盘钩子的回调函数的参数结构在
这里, 我们定义的函数名无所谓, 参数必须按照Windows的规定来.
还有, 这个回调函数的调用惯例必须是: stdcall; 我们在上例中是先在接口区声明, 如果不要声明直接实现, 也不能忘了这个 stdcall.

根据以上说明, 做如下修改:
SetWindowsHookEx 的参数有变通;
并且取消了钩子函数在接口区的声明, 是直接实现的;
取消了拦截条件, 现在只要是键盘消息全都拦截.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  hook: HHOOK; {定义一个钩子句柄}

{现在这个钩子函数没有在接口区声明, 这里必须指定参数调用方式: stdcall}
function KeyHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Beep;
  Result := CallNextHookEx(hook, nCode, wParam, lParam);
end;

{设置键盘钩子}
procedure TForm1.FormCreate(Sender: TObject);
begin
  hook := SetWindowsHookEx(WH_KEYBOARD, Addr(KeyHook), HInstance, GetCurrentThreadId);
end;

{释放键盘钩子}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnhookWindowsHookEx(hook);
end;

end.
钩子函数为什么非得使用 stdcall 调用机制? 因为钩子函数不是被应用程序调用, 而是被系统调用的
 
使用钩子函数 建立一个全局的鼠标钩子 
分两步:
一、建立 DLL, 并在 DLL 实现钩子的设置、释放和钩子函数;
二、再建一个工程调用测试.
 

第一步: 做 DLL



先建立一个 DLL 工程, 自动初始的代码如下(去掉注释了):
 
library Project1;

uses
  SysUtils,
  Classes;

{$R *.res}

begin
end.


//把工程保存为 MyHook.dpr, 并实现如下:

library MyHook;

uses
  SysUtils,
  Windows,  {钩子函数都来自 Windows 单元}
  Messages, {消息 WM_LBUTTONDOWN 定义在 Messages 单元}
  Classes;

{$R *.res}

var
  hook: HHOOK; {钩子变量}

{钩子函数, 鼠标消息太多(譬如鼠标移动), 必须要有选择, 这里选择了鼠标左键按下}
function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if wParam = WM_LBUTTONDOWN then
  begin
    MessageBeep(0);
  end;
  Result := CallNextHookEx(hook, nCode, wParam, lParam);
end;

{建立钩子}
function SetHook: Boolean; stdcall;
begin
  hook := SetWindowsHookEx(WH_MOUSE, @MouseHook, HInstance, 0);
  Result := hook <> 0;
end;

{释放钩子}
function DelHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(hook);
end;

{按 DLL 的要求输出函数}
exports
  SetHook name 'SetHook',
  DelHook name 'DelHook',
  MouseHook name 'MouseHook';

//SetHook, DelHook, MouseHook; {如果不需要改名, 可以直接这样 exports}

begin
end.
注意: SetWindowsHookEx 的第一个参数 WH_MOUSE 说明这是个鼠标钩子; 第四个参数 0 说明是全局的.
鼠标钩子回调函数的格式在
这里

然后按 Ctrl+F9 编译, 在工程目录下会生成一个和工程同名的文件, 这里是: MyHook.dll.
 

第二步: 调用

新建工程后, 保存, 并把刚才制作的 MyHook.dll 复制到这个工程目录下;
然后添加两个按钮, 实现如下:
 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

  {DLL 中的函数声明}
  function SetHook: Boolean; stdcall;
  function DelHook: Boolean; stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{DLL 中的函数实现, 也就是说明来自那里, 原来叫什么名}
function SetHook; external 'MyHook.dll' name 'SetHook';
function DelHook; external 'MyHook.dll' name 'DelHook';

{建立钩子}
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetHook;
end;

{销毁钩子}
procedure TForm1.Button2Click(Sender: TObject);
begin
  DelHook;
end;

end.
测试: 点击第一个按钮后, 钩子就启动了; 这是不管鼠标在哪点一下鼠标左键都会 "呯" 的一下; 点击第二个按钮可以收回钩子. 

下面是动态调用的方法, 功能和上面完全一直:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{要先要定义和 DLL 中同样参数和返回值的的函数类型}
type
  TDLLFun = function: Boolean; stdcall;
  {现在需要的 DLL 中的函数的格式都是这样, 定义一个就够了}

var
 h: HWND;                   {声明一个 DLL 句柄}
 SetHook, DelHook: TDLLFun; {声明两个 TDLLFun 变量}


{载入 DLL 并调用其函数}
procedure TForm1.Button1Click(Sender: TObject);
begin
  h := LoadLibrary('MyHook.dll'); {载入 DLL 并获取句柄}
  if h<>0 then
  begin
    SetHook := GetProcAddress(h, 'SetHook'); {让 SetHook 指向 DLL 中相应的函数}
    DelHook := GetProcAddress(h, 'DelHook'); {让 DelHook 指向 DLL 中相应的函数}
  end else ShowMessage('Err');

  SetHook; {执行钩子建立函数, 这里的 SetHook 和它指向的函数是同名的, 也可以不同名}
end;

{销毁钩子, 并释放 DLL}
procedure TForm1.Button2Click(Sender: TObject);
begin
  DelHook;        {执行钩子释放函数}
  FreeLibrary(h); {释放 DLL 资源}
end;

end.
为什么全局钩子非要在 DLL 中呢?
因为每个 EXE 都是一个独立而封闭的进程; 而 DLL 则是面向系统的公用资源.
如果一个钩子不是面向系统的, 恐怕意义不大; 所以在实用中, 钩子是离不开 DLL 的
 
钩子链和 CallNextHookEx 的返回值
SetWindowsHookEx 函数的第一个参数表示钩子类型, 共有 14 种选择, 前面我们已经用过两种:
WH_KEYBOARD、WH_MOUSE.

系统会为每一种类型的钩子建立一个表(那就是 14 个表), 譬如某个应用程序启动了键盘钩子, 我们自己的程序也启动了键盘钩子, 同样是键盘钩子就会进入同一个表. 这个表(可能不止一个, 可能还会有鼠标钩子等等)就是传说中的"钩子链".

假如某个钩子链中共进来了三个钩子(譬如是: 钩子A、钩子B、钩子C 依次进来), 最后进来的 "钩子C" 会先执行.
是不是先进后出? 我觉得应该说成: 后进先出! 这有区别吗? 有! 因为先进来的不一定出得来.
最后进了的钩子会最先得到执行, 先前进来的钩子(钩子A、钩子B)能不能得到执行那还得两说, 这得有正在执行的 "钩子C" 说了算.
如果 "钩子C" 的函数中包含了 CallNextHookEx 语句, 那么 "钩子A、钩子B" 就有可能得以天日; 不然就只有等着相应的
UnhookWindowsHookEx 来把它们带走(我想起赵本山的小品...).

这时你也许会想到: 这样太好了, 我以后就不加 CallNextHookEx , 只让自己的钩子"横行"; 但如果是你的钩子先进去的呢?
所以 Windows 建议: 钩子函数要调用 CallNextHookEx, 并把它的返回值当作钩子函数自己的返回值.

CallNextHookEx 同时要给钩子链中的下一个(或许应该叫上一个)钩子传递参数(譬如在键盘消息中按了哪个键). 一个键盘钩子和鼠标钩子的参数一样吗? 当然不一样, 所以它们也不在一个 "链" 中啊; 同一个链中的钩子的类型肯定是一样的.
再聊聊钩子函数的返回值:
在这之前, 钩子函数的返回值, 我们都是遵循 Windows 的惯例, 返回了 CallNextHookEx 的返回值.
如果 CallNextHookEx 成功, 它会返回下一个钩子的返回值, 是个连环套;
如果 CallNextHookEx 失败, 会返回 0, 这样钩子链也就断了, 只有当前钩子还在执行任务.

不同类型的钩子函数的返回值是不同的, 对键盘钩子来讲如果返回一个非 0 的值, 表示它处理完以后就把消息给消灭了.
换句话说:
如果给键盘的钩子函数 Result := 0; 说明消息被钩子拦截并处理后就给 "放" 了;
如果给键盘的钩子函数 Result := 1; 说明消息被钩子拦截并处理后又给 "杀" 了.

在下面的例子中, 我们干脆不使用 CallNextHookEx (反正暂时就我一个钩子), 直接给返回值!
//示例代码:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

  {钩子函数声明}
  function MyKeyHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hook: HHOOK;

function MyKeyHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Form1.Memo1.Lines.Add(IntToStr(wParam)); {参数二是键值}
  Result := 0; {分别测试返回 0 或非 0 这两种情况}
end;

{派出钩子}
procedure TForm1.Button1Click(Sender: TObject);
begin
  hook := SetWindowsHookEx(WH_KEYBOARD, MyKeyHook, HInstance, GetCurrentThreadId);
  Memo1.Clear;
  Text := '钩子启动';
end;

{收回钩子}
procedure TForm1.Button2Click(Sender: TObject);
begin
  UnhookWindowsHookEx(hook);
  Text := '钩子关闭';
end;

{如果忘了收回钩子...}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hook<>0 then UnhookWindowsHookEx(hook);
end;

end.
小秘密: 发现没有, 这次在 SetWindowsHookEx 时, 第二参数(函数地址), 没有使用 @、也没有用 Addr, 怎么也行呢?
因为函数名本身就是个地址.
 
使用钩子函数 数据传递
 
上一个例子是从 DLL 中接受数据, 那怎么给 DLL 传递数据呢? 还有, 在接受数据时, 让 Timer 一直在那扫描也不是个好办法呀. 本例解决了这些问题(但不知解决了博友 "鹏" 的问题没有?).

为了方便测试, 提供一个源码下载吧:
https://files.cnblogs.com/del/MouseHook_2.rar
本例效果图(和上一例是一样的):


DLL 文件:
library MyHook;

uses
  SysUtils,
  Windows,
  Messages,
  Classes;

{$R *.res}

const WM_MyMessage = WM_USER + 1; {自定义消息}

var
  hook: HHOOK;
  info: string;
  h: HWND; {用作外部窗口的句柄}

{获取外部窗口的句柄}
function SetHWnd(hwnd: HWND): Boolean; stdcall;
begin
  h := hwnd;
  Result := True;
end;

function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case wParam of
    WM_MOUSEMOVE   : info := '鼠标位置';
    WM_LBUTTONDOWN : info := '按下';
    WM_LBUTTONUp   : info := '放开';
  end;
  info := Format('%s: %d,%d', [info, PMouseHookStruct(lParam)^.pt.X, PMouseHookStruct(lParam)^.pt.Y]);

  {通过消息把数据传递给指定窗口}
  PostMessage(h, WM_MyMessage, 0, Integer(PChar(info)));

  Result := CallNextHookEx(hook, nCode, wParam, lParam);
end;

function SetHook: Boolean; stdcall;
const
  WH_MOUSE_LL =14;
begin
  hook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0);
  Result := hook <> 0;
end;

function DelHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(hook);
end;

exports SetHook, DelHook, MouseHook, SetHWnd;
begin
end.
测试代码:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const WM_MyMessage = WM_USER + 1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MyMessage(var msg: TMessage); message WM_MyMessage; {定义一个消息方法接受消息}
  end;

  function SetHook: Boolean; stdcall;
  function DelHook: Boolean; stdcall;
  function SetHWnd(hwnd: HWND): Boolean; stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SetHook; external 'MyHook.dll';
function DelHook; external 'MyHook.dll';
function SetHWnd; external 'MyHook.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetHook;
  SetHWnd(Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DelHook;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Caption := '安装钩子';
  Button2.Caption := '载卸钩子';
  FormStyle := fsStayOnTop; {为了测试, 让窗口一直在前面}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DelHook;
end;

{把接受到的内容显示在窗体}
procedure TForm1.MyMessage(var msg: TMessage);
begin
  Text := PChar(msg.LParam);
end;

end.
测试窗体:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 78
  ClientWidth = 271
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 48
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 144
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 1
    OnClick = Button2Click
  end
end

 

 

 

 

 

 

 



钩子分两种, 一种是系统级的全局钩子; 一种是线程级的钩子.
全局钩子函数需要定义在 DLL 中, 从线程级的钩子开始比较简单.

其实钩子函数就三个:
设置钩子: SetWindowsHookEx
释放钩子: UnhookWindowsHookEx
继续钩子: CallNextHookEx
在线程级的钩子中经常用到 GetCurrentThreadID 函数来获取当前线程的 ID.

下面例子中设定了一个线程级的键盘钩子, 专门拦截字母 A.

posted on 2008-12-27 01:48  okwary  阅读(991)  评论(0编辑  收藏  举报
ggg