?????????????????????? 用Delphi實現Windows的鼠標鉤子函數

??? Delphi是基于PASCAL語言的Windows編程工具，功能十分強大。然而在Delphi的幫助
文件中，對Windows API函數的說明沿襲了 VC 的格式，和VC一樣，對很多API函數的用法
沒有舉例子詳細說明，對一些深入系統內部的API函數更是語焉不詳，給編程者帶來不便。
筆者僅就在Windows編程中鼠標鉤子函數（ＨＯＯＫ）的實現，舉例作一說明。
?? 鼠標鉤子函數也可叫做鼠標消息過濾器，是一種回調（ＣＡＬＬＢＡＣＫ）函數，歸
系統調用。如果用SetWindowsHook或SetWindowsHookEx安裝了鼠標鉤子函數的地址， 每
當在屏幕上移動鼠標時，系統便將控制權交給鼠標鉤子函數，這樣便使我們能夠有機會在
鼠標鉤子函數內部截獲各種鼠標消息，在這些消息還沒有送達應用程序隊列之前，顯示它
們，改變它們或直接傳給下一個缺省鼠標鉤子函數。注意，鼠標鉤子函數截獲的是系統級
消息，而不是單個應用程序隊列內的窗口消息；系統發給每個應用程序隊列的鼠標消息都
可以用鼠標鉤子函數來截獲。
??? ＶＣ的Spy和Ｄelphi的WinSpy均安裝了鉤子函數用來截獲各種系統級的消息，其中就
包括鼠標鉤子函數，鍵盤鉤子函數，窗口鉤子函數等。我們可以通過安裝鼠標鉤子函數來
仿制一個自己的ＳＰＹ，當鼠標移動時，我們立即獲得系統（包括非搶先的Windows3.1和
搶先Windows95）的控制權，在鼠標鉤子函數內部實時地截獲鼠標消息，顯示鼠標的位置
和狀態以及鼠標下窗口的局柄，標題欄，窗口類，窗口過程地址等。當然也可象“英漢通”
和“金山詞霸”一樣在鼠標鉤子函數內調用InvalidateRect()，InvalidateRgn()來獲得屏
幕上鼠標下的單詞。（屏幕抓字的詳情請見筆者的《深入Windows內部探險》中國計算機報
1998年第81期 ）。
? 　
??? 主程序ＳＰＹ及其動態連接庫ＭＯＵＳＥＤＬＬ的原代碼和詳細注釋如下：
{*****************************************************
?FILE?? :? MOUSEDLL.DPR?? mafeitao@371.net 1998/11/18
?〉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????????????????????? mafeitao@371.net
?實現 setHook? unHook mouseProc ３個輸出函數
?*************************************************************}
unit Mousep;

interface

uses
? SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
? Forms, Dialogs, StdCtrls;

{在ＤＬＬ中也可有ＦＯＲＭ型的變量}
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()，
?在Ｄelphi中如果用函數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的低１６位}
pseg:=hiword(l);???? {得到l的高１６位}
p:=ptr(pseg,poff);?? {合成指向MOUSEHOOKSTRUCT結構的指針}

{顯示屏幕上鼠標的Ｘ，Ｙ坐標}
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?????????????? mafeitao@371.net
?******************************************}
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.

總結

以上是生活随笔為你收集整理的用Delphi实现Windows的鼠标钩子函数的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。