delphi之钩子函数(三)

菜鸟编程 十五楼的鸟儿 1838浏览 0评论
钩子链和 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 (反正暂时就我一个钩子), 直接给返回值!
这是接下来例子的演示动画:
delphi之钩子函数(三) 菜鸟编程 第1张
动画中, 我在三种状态下分别给 Memo 输入了字母 a
当没启动钩子时, Memo 是可以正常输入的;
当钩子函数返回 0, 钩上以后, 先执行了钩子函数的功能(返回键值), 字母 a 也能输入成功;
当钩子函数返回非 0 值(譬如1), 钩上以后, 就只执行了钩子函数的功能(返回键值), 可怜的 Memo 不知道发生了什么.

但这里又有了新问题: 钩子函数返回键值时怎么...不是一个?
先提醒: 在前面用 Beep 测试时, 你有没有发现那个声音也不只一次, 这是一个道理.
因为按一次键就会发出两个消息: WM_KEYDOWN、WM_KEYUP, 我们没有指定拦截哪个, 就都拦截了.
那怎么区分这两个消息呢? 秘密在键盘钩子函数的第三个参数 lParam 里面, 等下一个话题再研究吧.
[code=delphi]
//示例代码:
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.[/code]

提示:在 SetWindowsHookEx 时, 第二参数(函数地址), 没有使用 @、也没有用 Addr, 怎么也行呢?
因为函数名本身就是个地址.

例子一;本例建立一个全局的鼠标钩子, 然后把鼠标的相关信息通过一个自定义的 GetInfo 函数传递给调用钩子的程序.
[code=delphi]
DLL 文件:

library MyHook;

uses
SysUtils,
Windows,
Messages,
Classes;

{$R *.res}

var
hook: HHOOK;
info: string;

function GetInfo: PChar;
begin
Result := PChar(info);
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]);
{此信息可通过 GetInfo 函数从外部提取}

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

function SetHook: Boolean; stdcall;
const
WH_MOUSE_LL =14; {Delphi 少给了两个常量: WH_KEYBOARD_LL = 13; WH_MOUSE_LL = 14; 需要时自己定义}
begin
hook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0); {WH_MOUSE 只是线程级的}
Result := hook <> 0;
end;

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

exports SetHook, DelHook, MouseHook, GetInfo;
begin
end.[/code]

测试代码:
[code=delphi]
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;

function SetHook: Boolean; stdcall;
function DelHook: Boolean; stdcall;
function GetInfo: PChar; stdcall;

var
Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.Button1Click(Sender: TObject);
begin
SetHook;
Timer1.Enabled := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := False;
DelHook;
end;

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

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

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Text := GetInfo;
end;

end.[/code]

测试窗体:
[code=delphi]
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
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 128
Top = 8
end
end[/code]

例子二:给 DLL 传递数据

DLL 文件:
[code=delphi]
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.[/code]

测试代码:
[code=delphi]
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.[/code]

测试窗体:
[code=delphi]
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[/code]
以上两例效果图如下:
delphi之钩子函数(三) 菜鸟编程 第2张

转载请注明:鸟儿博客 » delphi之钩子函数(三)

游客
发表我的评论 换个身份
取消评论

Hi,您需要填写昵称和邮箱!

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址

等待大佬打赏中~