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, ', ');就不会有问题。
