用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   [e-mail] 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                      [e-mail]
 實現 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               [e-mail]
 ******************************************}
program Maintry;

uses
  Forms,
  Tryp in 'TRYP.PAS' {Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

{*********************************************
 TRYP.PAS                    [e-mail]
 ********************************************}

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.

http://blog.csdn.net/diligentcatrich/article/details/6934092