系统钩子[02] 安装全局鼠标钩子

Delphi DLL代码(Delphi Xe下测试通过)：

library Project1; 

 uses    SysUtils, Classes, Windows, Messages; 

 var    
  Hook: HHOOK;    
  Hooked: Boolean;    
  ParentHandle: DWORD;  
const    
  WM_MouseClk = WM_USER + 2046;
  //自定义消息  
  {$R *.res}  
  //钩子处理函数  
  
function MyHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall;  
var    
  Tmp: string;  
begin    
  Tmp := Format('X: %d , Y: %d', [PMouseHookStruct(lParam)^.pt.X,
                                  PMouseHookStruct(lParam)^.pt.Y]);    
  PostMessage(ParentHandle, WM_MouseClk, 0, Integer(PChar(Tmp)));
  //将鼠标坐标发送到接收端
  //将消息传递到下一个钩子    
  Result := CallNextHookEx(Hook, nCode, wParam, lParam);  
end;
  //安装钩子  
  
function SetHook(AParentHandle: DWORD): Boolean; stdcall;  
begin    
  Result := false;    
  if not Hooked then
  //防止重复加载钩子    
  begin      
    ParentHandle := AParentHandle;      
    HOOK         := SetWindowsHookEx(WH_MOUSE_LL, MyHookProc, HInstance, 0);      
    Result       := Hook <
      > 
    0;      
    Hooked := Result;
    //标记是否成功创建钩子    
  end;  
end;
  //删除钩子  
  
function DelHook: Boolean; stdcall;  
begin    
  Result := false;    
  if Hooked then    
  begin      
    Result := UnhookWindowsHookEx(Hook);      
    Hooked := Result;    
  end;  
end;  

exports   
  SetHook, 
  DelHook, 
  MyHookProc; 

begin    
  Hooked := false;  
end.

Delphi EXE代码

unit Unit1; 

interface 

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

const    
  WM_MouseClk = WM_USER + 2046;
  //自定义消息 
type    
  TForm1 = class(TForm)      
    btnInstaller: TButton;      
    btnUninstaller: TButton;      
    procedure btnInstallerClick(Sender: TObject);      
    procedure btnUninstallerClick(Sender: TObject);      
    procedure MsgProc(var Msg: TMessage); message WM_MouseClk;
    //消息处理函数    
  private      
    { Private declarations }      
    function InstallerUninstallerHook(Installer: Boolean): Boolean;    
  public      
    { Public declarations }    
  end; 
var    
  Form1: TForm1; 

implementation {$R *.dfm} { TForm1 }  

procedure TForm1.btnInstallerClick(Sender: TObject);  
begin    
  if InstallerUninstallerHook(true) then      
    ShowMessage('安装钩子成功')    
  else      
    ShowMessage('安装钩子失败');  
end; 

procedure TForm1.btnUninstallerClick(Sender: TObject);  
begin    
  if InstallerUninstallerHook(false) then      
    ShowMessage('删除钩子成功')    
  else      
    ShowMessage('删除钩子失败');  
end;
 //安装卸载钩子的方法  
 
function TForm1.InstallerUninstallerHook(Installer: Boolean): Boolean;  
var    
  DllHandle: DWORD;    
  SetHook: function (AHandle: DWORD): Boolean; stdcall;
  DelHook: function: Boolean; stdcall;  
begin    
  try      
    DllHandle := LoadLibrary('D:\我的文档\RAD Studio\Projects\Debug\Win32\Project1.dll');
      
    Result := false;      
    if DllHandle = 0 then
      //        
      raise Exception.Create('载入DLL失败')      
    else      
    begin        
      SetHook := GetProcAddress(DllHandle, 'SetHook');        
      DelHook := GetProcAddress(DllHandle, 'DelHook');        
      if Installer then          
        Result := SetHook(Self.Handle)        
      else          
        Result := DelHook;      
    end;    
  finally      
    FreeLibrary(DllHandle);    
  end;  
end;
  //将鼠标坐标显示于标题栏上  
  
procedure TForm1.MsgProc(var Msg: TMessage);  
begin    
  Self.Caption := PChar(Msg.lParam);  
end;  

end.