Delphi是基于PASCAL语言的Windows编程工具,功能十分强大。然而在Delphi的帮助

文件中,对Windows API函数的说明沿袭了 VC 的格式,和VC一样,对很多API函数的用法

没有举例子详细说明,对一些深入系统内部的API函数更是语焉不详,给编程者带来不便。

笔者仅就在Windows编程中鼠标钩子函数(HOOK)的实现,举例作一说明。

   鼠标钩子函数也可叫做鼠标消息过滤器,是一种回调(CALLBACK)函数,归

系统调用。如果用SetWindowsHook或SetWindowsHookEx安装了鼠标钩子函数的地址, 每

当在屏幕上移动鼠标时,系统便将控制权交给鼠标钩子函数,这样便使我们能够有机会在

鼠标钩子函数内部截获各种鼠标消息,在这些消息还没有送达应用程序队列之前,显示它

们,改变它们或直接传给下一个缺省鼠标钩子函数。注意,鼠标钩子函数截获的是系统级

消息,而不是单个应用程序队列内的窗口消息;系统发给每个应用程序队列的鼠标消息都

可以用鼠标钩子函数来截获。

    VC的Spy和Delphi的WinSpy均安装了钩子函数用来截获各种系统级的消息,其中就

包括鼠标钩子函数,键盘钩子函数,窗口钩子函数等。我们可以通过安装鼠标钩子函数来

仿制一个自己的SPY,当鼠标移动时,我们立即获得系统(包括非抢先的Windows3.1和

抢先Windows95)的控制权,在鼠标钩子函数内部实时地截获鼠标消息,显示鼠标的位置

和状态以及鼠标下窗口的局柄,标题栏,窗口类,窗口过程地址等。当然也可象“英汉通”

和“金山词霸”一样在鼠标钩子函数内调用InvalidateRect(),InvalidateRgn()来获得屏

幕上鼠标下的单词。(屏幕抓字的详情请见笔者的《深入Windows内部探险》中国计算机报

1998年第81期 )。

   

    主程序SPY及其动态连接库MOUSEDLL的原代码和详细注释如下:

{*****************************************************

 FILE   :  MOUSEDLL.DPR   

 〉DLL  :  MOUSEDLL.DLL

 EXPORT: sethook      用来安装鼠标钩子函数 mouseproc

         unhook       解除对鼠标钩子函数 mouseproc的安装

         mouseproc    鼠标钩子函数本身

 *****************************************************}

library Mousedll;

uses

  Mousep in 'MOUSEP.PAS' {Form1};

exports

sethook,

unhook,

mouseproc;

{$R *.RES}

begin

end.

{*************************************************************

 file:Mousep.pas                    ​

 实现 setHook  unHook mouseProc 3个输出函数

 *************************************************************}

unit Mousep;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

  Forms, Dialogs, StdCtrls;

{在DLL中也可有FORM型的变量}

type

  TForm1 = class(TForm)

    Label1: TLabel;  {显示wParam}

    Label2: TLabel;  {显示lParam}

    Label3: TLabel;  {显示x,y}

    Label4: TLabel;  {显示hwnd}

    Label5: TLabel;  {显示window text}

    Label6: TLabel;

    Label7: TLabel;  {显示window class}

  private

    { Private declarations }

  public

    { Public declarations }

  end;

function sethook:bool;export;

function unhook:bool;export;

function mouseProc(code:integer;w:integer;l:longint):bool;export;

var

  Form1: TForm1;

  idhook:longint;

  formok:bool;

implementation

 {*********************************************************************

 声明安装函数setWindowsHookEx(),

 在Delphi中如果用函数setWindowsHook()则不需声明。

 微软说函数setWindowsHook已在Windows3.1中废弃,为与Windows3.0兼容仍保留。

 实际上该函数setWindowsHook在Windows3.1和Windows95中仍可使用。

 {*********************************************************************}

 function setwindowsHookEx(id:integer;proc:tfarproc;hinst,htask:thandle):

         longint;far;external 'user';

{$R *.DFM}

{安装鼠标钩子函数mouseProc}

function sethook:bool;

var

hinst:thandle;    {该动态连接库自己的模块局柄}

proc:tfarproc;    {鼠标钩子函数mouseProc的地址}

begin

{在动态连接库中创建form1}

if formok=false then form1:=tform1.create(application) else exit;

formok:=true;{安装form1 后,设置formok,不许再安装form1}

{动态连接库的application指:调用动态连接库的主程序}

form1.show;

{不让用系统菜单来双击关闭Form1}

form1.BorderIcons:=form1.BorderIcons-[biSystemMenu];

hinst:=getModuleHandle('mousedll');

{得到mousedll.dll的模块局柄,即该动态连接库自己的模块局柄}

proc:=getProcAddress(hinst,'mouseProc');

idhook:=setWindowsHookEx(WH_MOUSE,proc,hinst,0);

{用WH_MOUSE参数安装鼠标钩子后,移动鼠标时,系统自动调用mouseProc钩子}

if idhook =0 then sethook:=false else sethook:=true;

end;

{解除鼠标钩子函数mouseProc的安装}

function unhook:bool;

begin

if formok=true then form1.free else exit; {检查form1是否已经关闭}

formok:=false;{关闭了form1,设置formok=0}

if idhook=0 then exit;

unhookWindowsHookEx(idhook);

unhook:=true;

end;

{mouseProc不由应用程序调用,而是在鼠标移动后,由系统调用}

function  mouseProc(code:integer;w:integer;l:longint):bool;

var

p:^TMouseHookStruct;

poff:word;

pseg:word;

pmemo:pchar;

begin

if code<0 then begin

    mouseProc:=true;

    CallNextHookEx(idhook,0,w,l);

end;

if code=HC_NOREMOVE then form1.caption:='HC_NOREMOVE';

form1.caption:='mouse hook';

mouseProc:=false;

{显示系统传来的wParam参数,w是各种鼠标消息的标识符  }

form1.label1.caption:='wParam='+intTostr(w);

{显示系统传来的lParam参数,l是MOUSEHOOKSTRUCT结构的地址}

form1.label2.caption:='lParam='+intTostr(l);

poff:=loword(l);     {得到l的低16位}

pseg:=hiword(l);     {得到l的高16位}

p:=ptr(pseg,poff);   {合成指向MOUSEHOOKSTRUCT结构的指针}

{显示屏幕上鼠标的X,Y坐标}

form1.label3.caption:='pt.x='+intTostr(p^.pt.x)

     +'  pt.y='+intTostr(p^.pt.y);

{显示屏幕上鼠标下的窗口局柄}

form1.label4.caption:='hwnd='+intTostr(P^.hwnd);

pmemo:=stralloc(20);

getWindowText(p^.hwnd,pmemo,20-1);

{显示鼠标下窗口的标题栏}

form1.label5.caption:=strPas(pmemo);

getClassName(p^.hwnd,pmemo,20-1);

{显示鼠标下窗口的类}

form1.label6.caption:=strPas(pmemo);

strDispose(pmemo);

end;

end.

主程序原代码如下:

{*******************************************

 MAINTRY.DPR            ​

 ******************************************}

program Maintry;

uses

  Forms,

  Tryp in 'TRYP.PAS' {Form1};

{$R *.RES}

begin

  Application.CreateForm(TForm1, Form1);

  Application.Run;

end.

{*********************************************

 TRYP.PAS                    ​​mafeitao@371.net​

 ********************************************}

unit Tryp;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

  Forms, Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;       { 安装setHook按钮}

    Button2: TButton;       { 解除 unHook按钮}

    Label1: TLabel;         {显示安装,解除是否成功}

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

function sethook:bool;far;external 'mousedll';

function unhook:bool;far;external 'mousedll'; 

  {声明后自动加载模块mousedll.dll}

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

if sethook then label1.caption:='set hook ok'; {安装鼠标钩子函数}

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if unhook then label1.caption:='unhook ok';    {解除鼠标钩子函数}

end;

end.