delphi中的HOOK [转贴]

按事件分类，有如下的几种常用类型的钩子：

1)键盘钩子可以监视各种键盘消息。

2)鼠标钩子可以监视各种鼠标消息。

3)外壳钩子可以监视各种Shell事件消息。

4)日志钩子可以记录从系统消息队列中取出的各种事件消息。

5)窗口过程钩子监视所有从系统消息队列发往目标窗口的消息。

安装钩子：SetWindowsHookEx

卸载钩子：UnhookWindowsHookEx

钩子回调函数形式：

function GetMsgProc(Code: UINT; lParam: LPARAM; wParam: WPARAM): LRESULT; stdcall;

Code：钩子代码，通常为HA_ACTION时是用户要处理的

lParam, wParam：跟具体安装的钩子类型有关的封装了缴获到的消息结构的参数

系统全局钩子必须在DLL中，因为它影响系统的所有应用程序，需要在消息发生时被系

统映射到其他进程的地址空间，从而调用DLL中的钩子回调函数。钩子所在的DLL被映射

时，是整体映射被加载到被挂钩的进程的地址空间中，而不仅仅是钩子回调函数，这

样，被挂钩的进程就可以访问DLL中的变量和调用其他函数的。利用这个特点，在应用

中就可以做到很多特定的功能，比如屏幕取词、木马、三级跳隐藏进程等。

注意：安装了某类消息的系统全局钩子之后，在该类消息发生时钩子DLL会被系统映射到其他

进程的地址空间，从而调用DLL中的钩子回调函数。

还有一点要注意：当SetWindowsHookEx调用成功后，系统会自动映射这个DLL到被挂钩

的线程，但并不是立即映射。因为所有的Windows钩子都是基于消息的，直到一个适当

的事件发生后这个DLL才被映射。同理，UnhookWindowsHookEx调用之后，也是在某个适

当的事件发生之后DLL才真正地从被挂钩线程卸载。

比如GetMessage钩子，lParam是Removal flag移除标志，wParam是个TMsg结构的指针

typedef struct tagMSG {     // msg

HWND   hwnd;

UINT   message;

WPARAM wParam;

LPARAM lParam;

DWORD  time;

POINT  pt;

} MSG;

三、实现

下面我们来讲如何解决一、4.中提到的问题。

1.在自己的进程中访问其他进程的对象实例

有了上面介绍的必备知识基础，那么现在这个问题对我们来说就不是很困难了，利用钩

子由系统将DLL注入目标进程，这时DLL就在目标进程的地址空间中了，这样，DLL中的

访问目标进程的对象实例的代码就可以工作了。

2.得到其他进程的DBGrid对象实例

DLL注入目标进程之后，实际上DLL和目标进程就在一个进程中了，那么按理说我们用

FindControl函数应该就可以由DBGrid句柄得到DBGrid对象实例的了，但实际并非如此！

实际写代码测试一下我们可以发现它返回的是nil。

function FindControl(Handle: HWnd): TWinControl;

var

OwningProcess: DWORD;

begin

Result := nil;

if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and

(OwningProcess = GetCurrentProcessId) then // 判断调用进程ID是否为Handle所在进程

begin

if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then

Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))

else

Result := ObjectFromHWnd(Handle);

end;

end;

-----

function ObjectFromHWnd(Handle: HWnd): TWinControl;

var

OwningProcess: DWORD;

begin

if (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and

(OwningProcess = GetCurrentProcessID) then

Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))

else

Result := nil;

end;

再看看其中使用到的ControlAtomString, ControlAtom, RM_GetObjectInstance的值是怎

样的(InitControls中)：

procedure InitControls;

var

UserHandle: HMODULE;

begin

WindowAtomString := Format('Delphi%.8X',[GetCurrentProcessID]);

WindowAtom := GlobalAddAtom(PChar(WindowAtomString));

ControlAtomString := Format('ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]);

ControlAtom := GlobalAddAtom(PChar(ControlAtomString));

RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));

...

end;

看到这里，我们可以发现问题之所在了。ControlAtomString是根据模块句柄(模块加载基

地址)和线程ID动态生成的，目标进程的模块基地址就是EXE基地址，一般是0x00400000，

但DLL的模块加载基地址就不是这个了，默认是0x10000000，而实际上可能因为这个地址

已经被占用(有其他DLL被加载到这个地址)而进行重定位，所以初始化时添加的

ControlAtom和目标进程的ControlAtom的值就不一样，RM_GetObjectInstance也同样是不

一样的，那FindControl当然就不能找到DBGrid对象实例啦。

OK，清楚了这一点，解决起来就简单了，我们自己写个FindControl函数，以目标进程基

地址来动态生成ControlAtomString，添加ControlAtom就可以啦。

在DLL中取EXE的基地址，用GetModuleHandle(nil)即可。

var

ControlAtom: TAtom;

ControlAtomString: string;

RM_GetObjectInstance: DWORD;  // registered window message

function FindControl(Handle: HWnd): TWinControl;

var

OwningProcess: DWORD;

begin

Result := nil;

if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and

(OwningProcess = GetCurrentProcessId) then

begin

if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then

Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))

else

Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0));

end;

end;

initialization

ControlAtomString := Format('ControlOfs%.8X%.8X', [GetModuleHandle(nil), GetCurrentThreadID]);

ControlAtom := GlobalAddAtom(PChar(ControlAtomString));

RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));

finalization

GlobalDeleteAtom(ControlAtom);

ControlAtomString := '';

end.

嗯，上面的FindControl我是把Controls.pas中FindControl和ObjectFromHWND合成一个函数了

// 获取目标进程中DBGrid的数据集的记录内容，保存到文件中

procedure ProcessDataSet(hCtrl: HWND);

var

F: TextFile;

FileName: string;

Grid: TDBGrid;

DataSet: TDataSet;

I: Integer;

begin

Grid := TDBGrid(FindControl(hCtrl)); // 根据句柄取得对象实例

if (Grid <> nil) and (Grid.DataSource <> nil) and (Grid.DataSource.DataSet <> nil) then

begin

FileName := ExtractFilePath(ParamStr(0)) + 'DataSet.txt'; // 目标程序运行目录下

AssignFile(F, FileName);

if FileExists(FileName) then Append(F) else Rewrite(F);

try

DataSet := Grid.DataSource.DataSet;

Writeln(F, FormatDateTime('yyyy-MM-dd HH:mm:ss', Now), ':');

DataSet.First;

while not DataSet.Eof do

begin

for I := 0 to DataSet.FieldCount - 1 do

Write(F, DataSet.Fields[I].AsString, ', ');

Writeln(F);

DataSet.Next;

end;

Writeln(F);

finally

CloseFile(F);

end;

end;

end;

这个代码，我们在实际测试时可以发现还是存在问题的，运行会出错，问题就在于

Write(F, DataSet.Fields[I].DisplayText, ', ');这一句，如果将这一句改成

Write(F, DataSet.Fields[I].Value, ', ');就不会有问题。