Jak założyć globalnego hooka

Chciałbym tutaj przedstawić, w jaki sposób w Delphi zrobić hooka (funkcje przechwytujące). Ale nie zwykłego, tylko globalnego i to takiego globalnego, który by działał nawet w chwili, kiedy nasza aplikacja nie jest aktywna w danym momencie. Jak wiemy aby zrobić funkcje przechwytującą należy skorzystać z funkcji SetWindowsHookEx i UnHookWindowsHookEx. Dodatkowo trzeba zdefiniować funkcje do obsługi przechwytywania zdarzeń, która wygląda standardowo tak:

TFNHookProc = function (nCode: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;

Funkcja powinna zawsze zwracać wartość z funkcji CallNextHookEx.

I tak aby stworzyć funkcje przechwytującą pobranie komunikatów myszki należało by to zrobić tak:

Var HintHook: HHOOK;

function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
var Window: Hwnd;
begin
  Result := CallNextHookEx(HintHook, nCode, wParam, lParam);
  if (nCode >= 0) then begin
  //tutaj instrukcje zwiazene z myszka, gdzie lparam jest wskaznikiem na strukture MouseHookStruct   
  end;
end;

begin
 HintHook:=SetWindowsHookEx(WH_MOUSE, @MouseHook, Hinstance, 0);
 ...

A zakończenie musiało by wyglądać tak:

 if (HintHook <> 0) then UnhookWindowsHookEx(HintHook);
End.

No dobra niby jest funkcja przechwytująca i to globalna (ostatni parametr funkcji SetWindowsHookEx jest 0, dlatego hook odnosi się do każdego wątku) to gdy program będzie działać, ale nie będzie aktywny wtedy program nie będzie odbierał funkcji przechwytujących. Jak to obejść? Odpowiedź jest jedna - należy funkcje przechwytującą umieścić w bibliotece dll, która będzie miała zmienne współdzielone, tzn. że jak nasz program nie będzie aktywny to i tak biblioteka będzie miała zmienne przypisane przez niego. Aby zrobić takową bibliotekę należy...no właśnie co? Po co mam tutaj zanudzać wszystkich teorią. Przejdę do rzeczy i przedstawię program, który przechwyci komunikaty myszki i w odpowiednich oknach (editach) będzie pokazywać klasę okna i uchwyt nad którą akurat znajduje się kursor myszki:

Ten program należy wpisać do pliku MojHook.dpr:

Program MojHook;

Uses SysUtils, Windows, Messages;

Const WM_KOMUNIKATMYSZY = WM_USER + 123;

var E1,E2,S1,S2,B1:Hwnd;

Function SetMouseHook(Okno: Hwnd): Boolean;  stdcall; external 'HOOK.DLL' name 'SetMouseHook';

procedure Uninstallhook; stdcall; external 'HOOK.DLL' name 'Uninstallhook';


Function WndProc(Okno:HWND;Msg:UINT; WParam:WParam;LParam:lParam):Integer; STDCALL;
var Buf: array [0..512] of char;
Begin
 Result:=0;
 Case Msg of
  WM_KOMUNIKATMYSZY:Begin
   GetClassName(WParam,buf,SizeOf(Buf));
   SetWindowText(E1,buf);
   SetWindowText(E2,pchar(IntToHex(WParam,8)+'h'));
  End;
  WM_COMMAND:If (LOWORD(wParam)=103) then DestroyWindow(Okno);
  WM_CREATE:Begin
   S1:=CreateWindow('STATIC','Nazwa klasy okna:',WS_CHILD or WS_VISIBLE,10,5,100,15,okno,-1,Hinstance,nil);
   S2:=CreateWindow('STATIC','Uchwyt okna:',WS_CHILD or WS_VISIBLE,10,45,100,15,okno,-1,Hinstance,nil);
   E1:=CreateWindowEx(WS_EX_CLIENTEDGE,'EDIT',nil,WS_CHILD or WS_VISIBLE or ES_READONLY,
                      10,20,300,20,okno,101,hinstance,nil);
   E2:=CreateWindowEx(WS_EX_CLIENTEDGE,'EDIT',nil,WS_CHILD or WS_VISIBLE or ES_READONLY,
                      10,60,300,20,okno,102,hinstance,nil);
   B1:=CreateWindow('BUTTON','Wyjście',WS_VISIBLE or WS_CHILD or BS_DEFPUSHBUTTON,
                    240,88,70,20,okno,103,Hinstance,nil);
   SendMessage(S1,WM_SETFONT,GetStockObject(DEFAULT_GUI_FONT),0);
   SendMessage(S2,WM_SETFONT,GetStockObject(DEFAULT_GUI_FONT),0);
   SendMessage(E1,WM_SETFONT,GetStockObject(DEFAULT_GUI_FONT),0);
   SendMessage(E2,WM_SETFONT,GetStockObject(DEFAULT_GUI_FONT),0);
   SendMessage(B1,WM_SETFONT,GetStockObject(DEFAULT_GUI_FONT),0);
   SetMouseHook(Okno);
  End;
  WM_DESTROY:begin
   UninstallHook;
   PostQuitMessage(0);
  End;
 Else Result:=DefWindowProc(Okno,Msg,WParam,LParam);
 End;
End;


Var KlasaOkna:TWndClass;
    Komunikat:TMsg;
    Okno:Hwnd;
begin
 KlasaOkna.style:=CS_HREDRAW or CS_VREDRAW;
 KlasaOkna.hInstance:=Hinstance;
 KlasaOkna.lpszClassName:='MTHOOK(C)MT';
 KlasaOkna.lpfnWndProc:=Nil;
 KlasaOkna.hIcon:=LoadIcon(0,IDI_APPLICATION);
 KlasaOkna.hCursor:=LoadCursor(0,IDC_ARROW);
 KlasaOkna.lpszMenuName:=0;
 KlasaOkna.cbClsExtra:=0;
 KlasaOkna.lpfnWndProc:=@WndProc;
 KlasaOkna.hbrBackground:=COLOR_WINDOW;
 If RegisterClass(KlasaOkna)=0 then Exit;
 Okno:=CreateWindowEx(WS_EX_TOPMOST,KlasaOkna.lpszClassName,
                     'Nad którym oknem jest kursor:',WS_OVERLAPPED or WS_SYSMENU,
                     10,10,330,150,0,0,Hinstance,nil);
 ShowWindow(Okno,SW_SHOWNORMAL);
 UpdateWindow(Okno);
 While GetMessage(Komunikat,0,0,0) do Begin
   TranslateMessage(Komunikat);
   DispatchMessage(Komunikat);
 End;
end.

---

Poniżej mamy bibliotekę przechwytującą:

Library Hook;

Uses Windows, Messages;

Const WM_KOMUNIKATMYSZY = WM_USER + 123;

Type PDane = ^TDane;
     TDane = record
              Okno: Hwnd;
              HintHook: HHOOK;
             end;

var Dane: PDane;


function MouseHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
var Window: Hwnd;
begin
  Result := CallNextHookEx(Dane^.HintHook, nCode, wParam, lParam);
  if (nCode >= 0) then begin
   Window:=WindowFromPoint(PMouseHookStruct(LParam)^.pt);
   PostMessage(Dane^.Okno,WM_KOMUNIKATMYSZY,Window,0);
  end;
end;


Function SetMouseHook(Okno: Hwnd): Boolean;  stdcall;
begin
 Dane^.Okno:=Okno;
 Dane^.HintHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, Hinstance, 0);
 result:=Dane^.HintHook<>0;
end;

procedure Uninstallhook; stdcall;
begin
 if Dane^.HintHook <> 0 then UnhookWindowsHookEx(Dane^.HintHook);
end;

Procedure DllEntryPoint(dwReason: DWord);
const  hMap:THandle=0;
Begin
 case dwReason of
  DLL_PROCESS_ATTACH: Begin
   hMap:=CreateFileMapping(DWORD(-1),nil,PAGE_READWRITE,0,sizeof(TDane),'SharedMem');
   If hMap=0 then Exit; {Mozna dodac tutaj obsluge bledu}
   Dane:=MapViewOfFile(hMap,FILE_MAP_WRITE,0,0,0);
  End;
  DLL_PROCESS_DETACH: Begin
   UnmapViewOfFile(Dane);
   CloseHandle(hMap);
  End;
 end;
End;

exports
  SetMouseHook,
  UninstallHook;

Begin
 DllProc:=@DllEntryPoint;
 DllEntryPoint(DLL_PROCESS_ATTACH);
End.

---

Program został napisany i sprawdzony w Delphi 2.0