FAQ » Win API

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.">
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.">
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

11 komentarzy

nazg 2007-10-27 17:53

A jak uzyskac informacje o kliknietym klawiszu myszki?

Twardy 2005-07-23 19:46

Przydziela pamiec do danych wspoldzielonych.

brodny 2005-06-27 18:35

Inaczej: powodem problemu są inne domyślne ustawienia kompilatora (sorki, że tak późno, ale nie patrzyłem wcześniej tego arta :) ). W Delphi 2 przełącznik {$WriteAbleConst} był włączony ({$WriteAbleConst On}), a w Delphi 5 bodajże wyłączony. Więc jedyne, co trzeba zrobić, to albo zmienić const na var i usunąć inicjalizację (ew. przenieść za begin) albo całą procedurkę wziąć w parę

{$WriteAbleConst On}
// ... procedurka ...
{$WriteAbleConst Off}

(ewentualnie {$J+}, {$J-})

Przy okazji pytanko: po co to mapowanie (CreateFileMapping())?

Twardy 2004-02-04 22:13

Dla KoRbIego i innych. Jak skompilować w delphi 7.
W bibliotece dll w wykasujemy cały wpis const z funkcji DllEntryPoint (const  hMap:THandle=0) i
wpisujemy go jako zmienną globalną var hMap:THandle;
W exeku w CreateWindow B1 i B2, tam gdzie jest
-1 wpisujemy DWORD(-1).
That's all

Twardy 2004-01-30 21:52

Byl, ale nie taki

koxak 2004-01-30 18:24

czy mi się wydaje czy o hookach już coś było?

lofix 2004-01-30 12:43

albo art bedzie kilim :>

Marooned 2004-01-30 12:27

wrzuć kod w tag &lt;delphi> &lt;/delphi>

Twardy 2004-02-03 22:30

Jedynie co mogę dodać to zawsze, ten sam program jeżeli kompiluje się w innej wersji kompilatora to należy wstawić poprawki aby program się kompilował. Należy zaglądać np. do plików źródłowych aby zobaczyć jaką dana zmenna może pobrać wartość itp.
Trudno mi jest co kolwiek doradzić, ale nie mam Delphi 7.0 a Delphi 2.0 i spokojnie sobie daje rade z najnowszymi aplikacjami.

KoRbI 2004-02-03 20:40

Mam Delphi7, które wypisuje mi: "Left side cannot be assigned to" na poniższą linię:
hMap:=CreateFileMapping(DWORD(-1),nil,PAGE_READWRITE,0,sizeof(TDane),'SharedMem');
Nie bawiłem się wcześniej z dll, wiec nie bardzo wiem co z tym zrobić.