Ĺadny brzuch
Witam, gdy zakladam globalnego hooka na klawiature w sposób taki:
Hook := SetWindowsHookEx(WH_JOURNALRECORD,Zapis,Hinstance,0);
Gdzie "zapis" jest moją funkcja, to wywala mi nastepujacy blad:
[Error] Unit1.pas(108): Incompatible types: 'regular procedure and method pointer' :(
Wiecie co jest z tym nietak :?
--------------------
GG: 4206396
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©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.
AUTOREM ARTU JEST TWARDY źrógło 4p
-----------------------
Bełdzio
Delphi Rules:)
www : http://www.beldzio.prv.pl
mail: beldzio(at)gazeta(dot)pl
Oferty pracy, współpracy, oferty matrymonialne, albo jak chcesz sobie Gadu-Gadu 3183960
cytat:
AUTOREM ARTU JEST TWARDY źrógło 4p
Tak mi się zdawało, że to już gdzieś widziałem 8)
----
m@il: ali88@tlen.pl
GG: 2083160
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
Hook := SetWindowsHookEx(WH_JOURNALRECORD,Zapis,Hinstance,0);
Gdzie "zapis" jest moją funkcja, to wywala mi nastepujacy blad:
[Error] Unit1.pas(108): Incompatible types: 'regular procedure and method pointer' :(
Wiecie co jest z tym nietak :?
--------------------
GG: 4206396
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©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.
AUTOREM ARTU JEST TWARDY źrógło 4p
-----------------------
Bełdzio
Delphi Rules:)
www : http://www.beldzio.prv.pl
mail: beldzio(at)gazeta(dot)pl
Oferty pracy, współpracy, oferty matrymonialne, albo jak chcesz sobie Gadu-Gadu 3183960
cytat:
AUTOREM ARTU JEST TWARDY źrógło 4p
Tak mi się zdawało, że to już gdzieś widziałem 8)
----
m@il: ali88@tlen.pl
GG: 2083160