调用程序
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, StrUtils, pubstr;
const
WM_MyMessage = WM_USER + 1 ;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure MyMessage( var msg: TMessage); message WM_MyMessage; { 定义一个消息方法接受消息 }
end ;
function SetHook: Boolean; stdcall ; external ' MyHook.dll ' ;
function DelHook: Boolean; stdcall ; external ' MyHook.dll ' ;
function SetHWnd(hwnd: HWND): Boolean; stdcall ; external ' MyHook.dll ' ;
var
Form1: TForm1;
implementation
{ $R *.dfm }
procedure TForm1.Button1Click(Sender: TObject);
begin
SetHook;
SetHWnd(Handle);
end ;
procedure TForm1.Button2Click(Sender: TObject);
begin
DelHook;
end ;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption : = ' 安装钩子 ' ;
Button2.Caption : = ' 载卸钩子 ' ;
// FormStyle : = fsStayOnTop; { 为了测试, 让窗口一直在前面 }
end ;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DelHook;
end ;
procedure TForm1.MyMessage( var msg: TMessage);
begin
Text : = PChar(msg.LParam);
end ;
end .
Dll 工程
library MyHook;
uses
SysUtils,
Windows,
Messages,
Classes;
{ $R *.res }
const WM_MyMessage = WM_USER + 1 ; { 自定义消息 }
var
hook: HHOOK;
info: string ;
h: HWND; { 用作外部窗口的句柄 }
function SetHWnd(hwnd: HWND): Boolean; stdcall ;
begin
h : = hwnd;
Result : = True;
end ;
function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall ;
begin
case wParam of
WM_MOUSEMOVE : info : = ' 鼠标位置 ' ;
WM_LBUTTONDOWN : info : = ' 按下 ' ;
WM_LBUTTONUp : info : = ' 放开 ' ;
end ;
info : = Format( ' %s: %d,%d ' , [info, PMouseHookStruct(lParam)^.pt.X, PMouseHookStruct(lParam)^.pt.Y]);
{ 此信息可通过 GetInfo 函数从外部提取 }
{ 通过消息把数据传递给指定窗口 }
PostMessage(h, WM_MyMessage, 0 , Integer(PChar(info)));
Result : = CallNextHookEx(hook, nCode, wParam, lParam);
end ;
function SetHook: Boolean; stdcall ;
const
WH_MOUSE_LL = 14 ; { Delphi 少给了两个常量: WH_KEYBOARD_LL = 13; WH_MOUSE_LL = 14; 需要时自己定义 }
begin
hook : = SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0 ); { WH_MOUSE 只是线程级的 }
Result : = hook <> 0 ;
end ;
function DelHook: Boolean; stdcall ;
begin
Result : = UnhookWindowsHookEx(hook);
end ;
exports SetHook, DelHook, MouseHook, SetHWnd;
begin
end .
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, StrUtils, pubstr;
const
WM_MyMessage = WM_USER + 1 ;
type
TForm1 = class (TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure MyMessage( var msg: TMessage); message WM_MyMessage; { 定义一个消息方法接受消息 }
end ;
function SetHook: Boolean; stdcall ; external ' MyHook.dll ' ;
function DelHook: Boolean; stdcall ; external ' MyHook.dll ' ;
function SetHWnd(hwnd: HWND): Boolean; stdcall ; external ' MyHook.dll ' ;
var
Form1: TForm1;
implementation
{ $R *.dfm }
procedure TForm1.Button1Click(Sender: TObject);
begin
SetHook;
SetHWnd(Handle);
end ;
procedure TForm1.Button2Click(Sender: TObject);
begin
DelHook;
end ;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption : = ' 安装钩子 ' ;
Button2.Caption : = ' 载卸钩子 ' ;
// FormStyle : = fsStayOnTop; { 为了测试, 让窗口一直在前面 }
end ;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DelHook;
end ;
procedure TForm1.MyMessage( var msg: TMessage);
begin
Text : = PChar(msg.LParam);
end ;
end .
Dll 工程
library MyHook;
uses
SysUtils,
Windows,
Messages,
Classes;
{ $R *.res }
const WM_MyMessage = WM_USER + 1 ; { 自定义消息 }
var
hook: HHOOK;
info: string ;
h: HWND; { 用作外部窗口的句柄 }
function SetHWnd(hwnd: HWND): Boolean; stdcall ;
begin
h : = hwnd;
Result : = True;
end ;
function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall ;
begin
case wParam of
WM_MOUSEMOVE : info : = ' 鼠标位置 ' ;
WM_LBUTTONDOWN : info : = ' 按下 ' ;
WM_LBUTTONUp : info : = ' 放开 ' ;
end ;
info : = Format( ' %s: %d,%d ' , [info, PMouseHookStruct(lParam)^.pt.X, PMouseHookStruct(lParam)^.pt.Y]);
{ 此信息可通过 GetInfo 函数从外部提取 }
{ 通过消息把数据传递给指定窗口 }
PostMessage(h, WM_MyMessage, 0 , Integer(PChar(info)));
Result : = CallNextHookEx(hook, nCode, wParam, lParam);
end ;
function SetHook: Boolean; stdcall ;
const
WH_MOUSE_LL = 14 ; { Delphi 少给了两个常量: WH_KEYBOARD_LL = 13; WH_MOUSE_LL = 14; 需要时自己定义 }
begin
hook : = SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0 ); { WH_MOUSE 只是线程级的 }
Result : = hook <> 0 ;
end ;
function DelHook: Boolean; stdcall ;
begin
Result : = UnhookWindowsHookEx(hook);
end ;
exports SetHook, DelHook, MouseHook, SetHWnd;
begin
end .