Кто-нибудь писал ловушки (hooks)? Подскажите ...

← →
star (2002-01-28 15:36) [2]

Показываю:

library myDll;

uses
windows,
CommCtrl,
Messages;

const
cMMFileName: PChar = "SharedMapData";

type
PGlobalDLLData = ^TGlobalDLLData;
TGlobalDLLData = record
FormWnd:HWND;
MyHook:HHook;
end;

var
GlobalData:PGlobalDLLData;
MapHandle:THandle;
Wnd:HWND;

{
WindowDebugger
------------
Процедура перехватывает сообщения передаваемые системой процедурам окна.
}

function WindowDebugger (code: integer; wParam: longint; lParam: longint): longword; stdcall;
var
Struct:^CWPSTRUCT;
msg:cardinal;
p:PChar;
Item:^TLVItem;
cdt:TCopyDataStruct;
begin
if code<0 then begin
if (GlobalData<>nil) and (GlobalData^.MyHook<>0) then
WindowDebugger:=CallNextHookEx(GlobalData^.MyHook,code,wParam,lparam)
else WindowDebugger:=0;
Exit;
end;

// lParam содержит указатель на структуру, содержащую информацию о сообщении
Struct:=pointer(lParam);
if Struct<>nil then msg:=Struct^.message
else msg:=0;

// При возникновении следующих событий уведомляется главное приложение
case msg of
WM_CREATE:
if Wnd<>0 then SendMessage (Wnd,WM_USER,Struct^.message,Struct^.hwnd);

WM_DESTROY:
if Wnd<>0 then SendMessage (Wnd,WM_USER,Struct^.message,Struct^.hwnd);

LVM_INSERTITEM:
begin
Item:=Pointer(Struct^.lparam);
if Item<>nil then
begin
if Item^.pszText<>LPSTR_TEXTCALLBACK then
begin
p:=Item^.pszText;
Cdt.dwData:=LVM_INSERTITEM;
Cdt.cbData:=Item^.cchTextMax;
Cdt.lpData:=p;
if Wnd<>0 then SendMessage (Wnd,WM_COPYDATA,Struct^.hwnd,integer(@cdt));
end
else begin
Cdt.dwData:=0;
Cdt.cbData:=0;
Cdt.lpData:=nil;
end;
end;
if Wnd<>0 then SendMessage (Wnd,WM_USER,Struct^.message,Struct^.hwnd);
end;

WindowDebugger:=0;

if (GlobalData<>nil) and (GlobalData^.MyHook<>0) then
WindowDebugger:=CallNextHookEx(GlobalData^.MyHook,code,wParam,lparam);
exit;
end;

{
SetHookHandle
-------------
Энта процедура вызывается из головного приложения дабы сообщить нашей ловушке
дескриптор следующей ловушки в очереди
}

procedure SetHandle(HookHandle: HHook;Wnd:HWND); stdcall;
begin
if GlobalData <> nil then GlobalData^.MyHook:=HookHandle;
end;

procedure OpenSharedData;
var
Size:Integer;
begin
Size:=SizeOf (TGlobalDLLData);
MapHandle:= CreateFileMapping (DWord(-1),nil,PAGE_READWRITE,0,
Size,cMMFileName);

if MapHandle<>0 then
begin
GlobalData:=MapViewOfFile (MapHandle,FILE_MAP_ALL_ACCESS,0,0,Size);

if GlobalData=nil then
begin
CloseHandle (MapHandle);
end;
end;

// Найдем наше приложение чтобы передавать ему сообщения
Wnd:=FindWindow ("TForm1","Form1");
end;

procedure CloseSharedData;
begin
if GlobalData<>nil then
begin
UnmapViewOfFile (GlobalData);
CloseHandle (MapHandle);
end;
end;

procedure DLLEntryPoint (dwReason:DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenSharedData;
DLL_PROCESS_DETACH: CloseSharedData;
end;
end;

exports WindowDebugger,SetHandle;

begin
Wnd:=0;
DllProc:=@DLLEntryPoint;
DLLEntryPoint (DLL_PROCESS_ATTACH);
end.

Ловушка перехватывает некоторые сообщения и информирует о них главное приложение ...

Кто-нибудь писал ловушки (hooks)? Подскажите ... Найти похожие ветки