W
wanggongqin
Unregistered / Unconfirmed
GUEST, unregistred user!
{ 钩子 DLL 源代码 }
library HookDll;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
Dllfunc in 'Dllfunc.pas';
exports
StartHook, StopHook;
{$R *.res}
begin
end.
{--------------------------------------------------------}
unit Dllfunc;
interface
uses
Windows, SysUtils, Classes, Messages;
const
WM_Main_Accept = WM_User + 1;
function StartHook(AMainWnd: HWND): Boolean; stdcall; {开始钩子}
procedure StopHook; stdcall; {停止钩子}
function HookCallWndProc(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
function HookCallWndProcRet(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
{ 钩子响应函数 }
implementation
var
MainWnd: HWND;
{ 钩子消息发往这个窗体 }
hCallWndProc: THandle;
hCallWndProcRet: THandle;
{ 钩子类型变量 }
const
MsgArea: array[0..18] of UINT =
(WM_NCPAINT, WM_NCACTIVATE, WM_CHAR,
WM_ENABLE, WM_KEYUP, WM_LBUTTONUP, WM_MBUTTONUP, WM_PALETTECHANGED,
WM_RBUTTONUP, WM_SYSCOLORCHANGE, WM_SETFOCUS, WM_HSCROLL,
WM_VSCROLL, WM_WINDOWPOSCHANGING, WM_DESTROY, WM_WINDOWPOSCHANGED, WM_PAINT,
482, 485);
{ 定义响应消息的范围 }
function InMessageArea(const Msg: UINT): Boolean;
var
i: Integer;
begin
Result := False;
for i:=Low(MsgArea) to High(MsgArea) do
if MsgArea = Msg then
begin
Result := True;
Break;
end;
end;
function HookCallWndProc(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
var
Cwp: TCWPStruct;
begin
if nCode = HC_ACTION then
begin
Cwp := (PCWPStruct(lPar))^;
if InMessageArea(Cwp.message) then
PostMessage(MainWnd, WM_Main_Accept, Cwp.hwnd, Cwp.message);
{ 向主窗体发送发生消息的窗口句柄 }
end;
Result := CallNextHookEx(hCallWndProc, nCode, wPar, lPar);
end;
function HookCallWndProcRet(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
var
CwpRet: TCWPRetStruct;
begin
if nCode = HC_ACTION then
begin
CwpRet := (PCWPRetStruct(lPar))^;
if InMessageArea(CwpRet.message) then
PostMessage(MainWnd, WM_Main_Accept, CwpRet.hwnd, CwpRet.message);
{ 向主窗体发送发生消息的窗口句柄 }
end;
Result := CallNextHookEx(hCallWndProcRet, nCode, wPar, lPar);
end;
function StartHook(AMainWnd: HWND): Boolean; stdcall;
begin
MainWnd := AMainWnd;
hCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, HInstance, 0);
hCallWndProcRet := SetWindowsHookEx(WH_CALLWNDPROCRET, HookCallWndProcRet, HInstance, 0);
{ 钩子的目标线程是 0 ,应该对所有线程有效 }
Result := (hCallWndProc <> 0) and (hCallWndProcRet <> 0);
if not Result then StopHook;
end;
procedure StopHook; stdcall;
begin
if hCallWndProc <> 0 then UnhookWindowsHookEx(hCallWndProc);
if hCallWndProcRet <> 0 then UnhookWindowsHookEx(hCallWndProcRet);
end;
end.
{----------------------------------------------------------------}
{ 主程序源代码 }
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IniFiles;
const
WM_Main_Accept = WM_User + 1;
type
TForm1 = class(TForm)
btnBegin: TButton;
btnStop: TButton;
mmMessage: TMemo;
procedure btnBeginClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
procedure WMAcceptMessage(var AMessage: TMessage); message WM_Main_Accept;
public
{ Public declarations }
end;
function StartHook(AMainWnd: HWND): Boolean; stdcall; external 'HookDll.dll';
procedure StopHook; stdcall; external 'HookDll.dll';
var
Form1: TForm1;
RecFile: TIniFile;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.WMAcceptMessage(var AMessage: TMessage);
var
WinText: array[0..254] of Char;
begin
GetWindowText(AMessage.WParam, WinText, 255);
RecFile.WriteString('HookRec',DateTimeToStr(Now),
WinText+' 消息值:'+IntToStr(AMessage.LParam));
{ 把发生消息的信息记录到 Ini 文件中 }
end;
procedure TForm1.btnBeginClick(Sender: TObject);
begin
StartHook(Self.Handle);
RecFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Rec.txt');
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
RecFile.Free;
StopHook;
end;
end.
{----------------------------------------------------------}
程序运行后,只有本程序发生事件后,才响应钩子函数。
按照全局钩子的要求,我已经将钩子函数单独放到了 Dll 中,
为什么还是不能响应其它程序的消息。
library HookDll;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
Dllfunc in 'Dllfunc.pas';
exports
StartHook, StopHook;
{$R *.res}
begin
end.
{--------------------------------------------------------}
unit Dllfunc;
interface
uses
Windows, SysUtils, Classes, Messages;
const
WM_Main_Accept = WM_User + 1;
function StartHook(AMainWnd: HWND): Boolean; stdcall; {开始钩子}
procedure StopHook; stdcall; {停止钩子}
function HookCallWndProc(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
function HookCallWndProcRet(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
{ 钩子响应函数 }
implementation
var
MainWnd: HWND;
{ 钩子消息发往这个窗体 }
hCallWndProc: THandle;
hCallWndProcRet: THandle;
{ 钩子类型变量 }
const
MsgArea: array[0..18] of UINT =
(WM_NCPAINT, WM_NCACTIVATE, WM_CHAR,
WM_ENABLE, WM_KEYUP, WM_LBUTTONUP, WM_MBUTTONUP, WM_PALETTECHANGED,
WM_RBUTTONUP, WM_SYSCOLORCHANGE, WM_SETFOCUS, WM_HSCROLL,
WM_VSCROLL, WM_WINDOWPOSCHANGING, WM_DESTROY, WM_WINDOWPOSCHANGED, WM_PAINT,
482, 485);
{ 定义响应消息的范围 }
function InMessageArea(const Msg: UINT): Boolean;
var
i: Integer;
begin
Result := False;
for i:=Low(MsgArea) to High(MsgArea) do
if MsgArea = Msg then
begin
Result := True;
Break;
end;
end;
function HookCallWndProc(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
var
Cwp: TCWPStruct;
begin
if nCode = HC_ACTION then
begin
Cwp := (PCWPStruct(lPar))^;
if InMessageArea(Cwp.message) then
PostMessage(MainWnd, WM_Main_Accept, Cwp.hwnd, Cwp.message);
{ 向主窗体发送发生消息的窗口句柄 }
end;
Result := CallNextHookEx(hCallWndProc, nCode, wPar, lPar);
end;
function HookCallWndProcRet(nCode: Integer; wPar: WParam; lPar: LParam): LRESULT; stdcall;
var
CwpRet: TCWPRetStruct;
begin
if nCode = HC_ACTION then
begin
CwpRet := (PCWPRetStruct(lPar))^;
if InMessageArea(CwpRet.message) then
PostMessage(MainWnd, WM_Main_Accept, CwpRet.hwnd, CwpRet.message);
{ 向主窗体发送发生消息的窗口句柄 }
end;
Result := CallNextHookEx(hCallWndProcRet, nCode, wPar, lPar);
end;
function StartHook(AMainWnd: HWND): Boolean; stdcall;
begin
MainWnd := AMainWnd;
hCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, HInstance, 0);
hCallWndProcRet := SetWindowsHookEx(WH_CALLWNDPROCRET, HookCallWndProcRet, HInstance, 0);
{ 钩子的目标线程是 0 ,应该对所有线程有效 }
Result := (hCallWndProc <> 0) and (hCallWndProcRet <> 0);
if not Result then StopHook;
end;
procedure StopHook; stdcall;
begin
if hCallWndProc <> 0 then UnhookWindowsHookEx(hCallWndProc);
if hCallWndProcRet <> 0 then UnhookWindowsHookEx(hCallWndProcRet);
end;
end.
{----------------------------------------------------------------}
{ 主程序源代码 }
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IniFiles;
const
WM_Main_Accept = WM_User + 1;
type
TForm1 = class(TForm)
btnBegin: TButton;
btnStop: TButton;
mmMessage: TMemo;
procedure btnBeginClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
procedure WMAcceptMessage(var AMessage: TMessage); message WM_Main_Accept;
public
{ Public declarations }
end;
function StartHook(AMainWnd: HWND): Boolean; stdcall; external 'HookDll.dll';
procedure StopHook; stdcall; external 'HookDll.dll';
var
Form1: TForm1;
RecFile: TIniFile;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.WMAcceptMessage(var AMessage: TMessage);
var
WinText: array[0..254] of Char;
begin
GetWindowText(AMessage.WParam, WinText, 255);
RecFile.WriteString('HookRec',DateTimeToStr(Now),
WinText+' 消息值:'+IntToStr(AMessage.LParam));
{ 把发生消息的信息记录到 Ini 文件中 }
end;
procedure TForm1.btnBeginClick(Sender: TObject);
begin
StartHook(Self.Handle);
RecFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Rec.txt');
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
RecFile.Free;
StopHook;
end;
end.
{----------------------------------------------------------}
程序运行后,只有本程序发生事件后,才响应钩子函数。
按照全局钩子的要求,我已经将钩子函数单独放到了 Dll 中,
为什么还是不能响应其它程序的消息。