Delphi 全局鼠标钩子的简单演程序

2018-10-31

dll源代码:
---------------------------------------------------------------------------

library Project2;

uses
  SysUtils,
  Classes,
  Windows,Messages;


{$R *.res}
var
  hHook1:HHOOK;

function hookProc(
  nCode:Integer;    // hook code
  wParam:WPARAM;  // message identifier消息标识
  lParam:LPARAM   // mouse coordinates鼠标坐标
):LRESULT;stdcall;
begin
  if wParam=WM_LBUTTONDOWN then //只处理鼠标的左键按下消息
  begin
   MessageBeep(0);
  end;
  Result:=CallNextHookEx(hHook1,nCode,wParam,lParam);

end;

//设置鼠标钩子
function setHook:Boolean;stdcall;
begin

  hHook1:=SetWindowsHookEx(WH_MOUSE,@hookProc,HInstance,0);
  Result:=hHook1<>0;
end;

//删除鼠标钩子
function delHook:Boolean;stdcall;
begin
  Result:=UnhookWindowsHookEx(hHook1);
end;

exports  //导出函数
  setHook name 'setHook',
  delHook name 'delHook',
  hookProc name 'hookProc';

begin

end.

调用源代码:
---------------------------------------------------------------------------

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
  Private
   { Private declarations }
  public
   constructor Create(AOwner: TComponent); override;

   { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function setHook:Boolean;external 'project2.dll' name 'setHook';
function delHook:Boolean;external 'project2.dll' name 'delHook';

procedure TForm1.Button1Click(Sender: TObject);
begin
  if sethook then
   Label1.Caption:='钩子安装成功,按鼠标左键会发出声音';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if delHook then
   Label1.Caption:='勾子已经删除';
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  form1.Label1.Caption:='';
end;

end.


阅读34