分兩步:
一、建立 DLL, 並在 DLL 實現鉤子的設置、釋放和鉤子函數;
二、再建一個工程調用測試.
第一步: 做 DLL
先建立一個 DLL 工程, 自動初始的代碼如下(去掉注釋了):
library Project1;
uses
SysUtils,
Classes;
{$R *.res}
begin
end.
//把工程保存為 MyHook.dpr, 並實現如下:
library MyHook;
uses
SysUtils,
Windows, {鉤子函數都來自 Windows 單元}
Messages, {消息 WM_LBUTTONDOWN 定義在 Messages 單元}
Classes;
{$R *.res}
var
hook: HHOOK; {鉤子變量}
{鉤子函數, 鼠標消息太多(譬如鼠標移動), 必須要有選擇, 這裡選擇了鼠標左鍵按下}
function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if wParam = WM_LBUTTONDOWN then
begin
MessageBeep(0);
end;
Result := CallNextHookEx(hook, nCode, wParam, lParam);
end;
{建立鉤子}
function SetHook: Boolean; stdcall;
begin
hook := SetWindowsHookEx(WH_MOUSE, @MouseHook, HInstance, 0);
Result := hook <> 0;
end;
{釋放鉤子}
function DelHook: Boolean; stdcall;
begin
Result := UnhookWindowsHookEx(hook);
end;
{按 DLL 的要求輸出函數}
exports
SetHook name 'SetHook',
DelHook name 'DelHook',
MouseHook name 'MouseHook';
//SetHook, DelHook, MouseHook; {如果不需要改名, 可以直接這樣 exports}
begin
end.
注意: SetWindowsHookEx 的第一個參數 WH_MOUSE 說明這是個鼠標鉤子; 第四個參數 0 說明是全局的.
鼠標鉤子回調函數的格式在這裡:www.cnblogs.com/del/archive/2008/02/25/1080724.html
然後按 Ctrl+F9 編譯, 在工程目錄下會生成一個和工程同名的文件, 這裡是: MyHook.dll.
第二步: 調用
新建工程後, 保存, 並把剛才制作的 MyHook.dll 復制到這個工程目錄下;
然後添加兩個按鈕, 實現如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
{DLL 中的函數聲明}
function SetHook: Boolean; stdcall;
function DelHook: Boolean; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
{DLL 中的函數實現, 也就是說明來自那裡, 原來叫什麼名}
function SetHook; external 'MyHook.dll' name 'SetHook';
function DelHook; external 'MyHook.dll' name 'DelHook';
{建立鉤子}
procedure TForm1.Button1Click(Sender: TObject);
begin
SetHook;
end;
{銷毀鉤子}
procedure TForm1.Button2Click(Sender: TObject);
begin
DelHook;
end;
end.
測試: 點擊第一個按鈕後, 鉤子就啟動了; 這是不管鼠標在哪點一下鼠標左鍵都會 "呯" 的一下; 點擊第二個按鈕可以收回鉤子.
下面是動態調用的方法, 功能和上面完全一直:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{要先要定義和 DLL 中同樣參數和返回值的的函數類型}
type
TDLLFun = function: Boolean; stdcall;
{現在需要的 DLL 中的函數的格式都是這樣, 定義一個就夠了}
var
h: HWND; {聲明一個 DLL 句柄}
SetHook, DelHook: TDLLFun; {聲明兩個 TDLLFun 變量}
{載入 DLL 並調用其函數}
procedure TForm1.Button1Click(Sender: TObject);
begin
h := LoadLibrary('MyHook.dll'); {載入 DLL 並獲取句柄}
if h<>0 then
begin
SetHook := GetProcAddress(h, 'SetHook'); {讓 SetHook 指向 DLL 中相應的函數}
DelHook := GetProcAddress(h, 'DelHook'); {讓 DelHook 指向 DLL 中相應的函數}
end else ShowMessage('Err');
SetHook; {執行鉤子建立函數, 這裡的 SetHook 和它指向的函數是同名的, 也可以不同名}
end;
{銷毀鉤子, 並釋放 DLL}
procedure TForm1.Button2Click(Sender: TObject);
begin
DelHook; {執行鉤子釋放函數}
FreeLibrary(h); {釋放 DLL 資源}
end;
end.
為什麼全局鉤子非要在 DLL 中呢?
因為每個 EXE 都是一個獨立而封閉的進程; 而 DLL 則是面向系統的公用資源.
如果一個鉤子不是面向系統的, 恐怕意義不大; 所以在實用中, 鉤子是離不開 DLL 的.
請教大家: 全局鉤子可以做在 "包" 裡嗎? 我還沒試過.