Ĺadny brzuch
Witam.
Otóż do swojej aplikacji potrzebuje sprawdzać czy użytkownik jest idle. Robi to poprzez hook'a, którego mam założonego na klawiaturkę i myszkę. W razie kliknięcia jakiegoś klawisza, lub poruszenia myszką do swojego programu wysyłam komunikat, że user coś robi. Udało mi się napisać dll'ke, która wysyła komunikat, i w której działają hooki, ale kod jest całościowo sprawny tylko po skompilowaniu programu w d7 (dll'ka obojętnie w czym skompilowana jest taka sama). Problem objawia się tym, że jeśli "wjadę" myszką nad swój program (ten, który odbiera komunikaty, to program bardzo zwalnia i zaczyna używać pełnej mocy procesora) - natomist w d7 jest OK.
Oto kody:
dll:
library idle; uses Windows, Messages; const WM_AKTYWNY = WM_USER + 99; Type PDane = ^TDane; TDane = record Okno: Hwnd; HintHook: HHOOK; end; var Dane: PDane; hMap:THandle; function KeyboardHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall; begin Result := CallNextHookEx(Dane^.HintHook, nCode, wParam, lParam); if (nCode >= 0) then PostMessage(Dane^.Okno,WM_AKTYWNY,0,0); end; 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 PostMessage(Dane^.Okno,WM_AKTYWNY,0,0); end; Function SetMouseHook(Okno: Hwnd): Boolean; stdcall; begin Dane^.Okno:=Okno; Dane^.HintHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, Hinstance, 0); Dane^.HintHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, Hinstance, 0); result:=Dane^.HintHook<>0; end; procedure UninstallHook; stdcall; begin if Dane^.HintHook <> 0 then UnhookWindowsHookEx(Dane^.HintHook); end; Procedure DllEntryPoint(dwReason: DWord); 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.
uruchamianie dll'ki oraz odbieranie komunikatu w programie:
const WM_AKTYWNY = WM_USER + 99; //...... public procedure Odbierz(var MSG: TMEssage); message WM_AKTYWNY; //...... procedure TFOrm1.Odbierz(var MSG: TMEssage); begin Caption:= 'dostałem wiadomość'; end; procedure TForm1.FormShow(Sender: TObject); begin SetMouseHook(Handle); end;
Bardzo proszę o pomoc :)
Użytkownik -=PcSA=- edytował ten post 26 grudzień 2005, 21:32
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
Otóż do swojej aplikacji potrzebuje sprawdzać czy użytkownik jest idle. Robi to poprzez hook'a, którego mam założonego na klawiaturkę i myszkę. W razie kliknięcia jakiegoś klawisza, lub poruszenia myszką do swojego programu wysyłam komunikat, że user coś robi. Udało mi się napisać dll'ke, która wysyła komunikat, i w której działają hooki, ale kod jest całościowo sprawny tylko po skompilowaniu programu w d7 (dll'ka obojętnie w czym skompilowana jest taka sama). Problem objawia się tym, że jeśli "wjadę" myszką nad swój program (ten, który odbiera komunikaty, to program bardzo zwalnia i zaczyna używać pełnej mocy procesora) - natomist w d7 jest OK.
Oto kody:
dll:
library idle; uses Windows, Messages; const WM_AKTYWNY = WM_USER + 99; Type PDane = ^TDane; TDane = record Okno: Hwnd; HintHook: HHOOK; end; var Dane: PDane; hMap:THandle; function KeyboardHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Longint; stdcall; begin Result := CallNextHookEx(Dane^.HintHook, nCode, wParam, lParam); if (nCode >= 0) then PostMessage(Dane^.Okno,WM_AKTYWNY,0,0); end; 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 PostMessage(Dane^.Okno,WM_AKTYWNY,0,0); end; Function SetMouseHook(Okno: Hwnd): Boolean; stdcall; begin Dane^.Okno:=Okno; Dane^.HintHook := SetWindowsHookEx(WH_MOUSE, @MouseHook, Hinstance, 0); Dane^.HintHook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHook, Hinstance, 0); result:=Dane^.HintHook<>0; end; procedure UninstallHook; stdcall; begin if Dane^.HintHook <> 0 then UnhookWindowsHookEx(Dane^.HintHook); end; Procedure DllEntryPoint(dwReason: DWord); 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.
uruchamianie dll'ki oraz odbieranie komunikatu w programie:
const WM_AKTYWNY = WM_USER + 99; //...... public procedure Odbierz(var MSG: TMEssage); message WM_AKTYWNY; //...... procedure TFOrm1.Odbierz(var MSG: TMEssage); begin Caption:= 'dostałem wiadomość'; end; procedure TForm1.FormShow(Sender: TObject); begin SetMouseHook(Handle); end;
Bardzo proszę o pomoc :)
Użytkownik -=PcSA=- edytował ten post 26 grudzień 2005, 21:32