|
#1
|
|||
|
|||
Hook
Помогите, ставлю глобальную ловушк которая перехватывает нажатие на клавишу после чего посыаю сообщение в приложение на которое что-то срабатывает. Почему что-то срабатывает два раза?
Код:
========================================================= модуль ========================================================= unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Novator, StdCtrls; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } procedure WndProc(var Msg: TMessage); override; public { Public declarations } end; var Form1: TForm1; Par:ParamConnect; hDLL: THandle; WM_MYKEYHOOK: Cardinal; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall; begin Par.Host := 'localhost'; Par.Port := 1067; Par.AOwner := Self; //Регистрируем сообщение WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK'); //Устанавливаем хук @hook:= nil; hDLL:= LoadLibrary(PChar('keyhook.dll')); @hook:=GetProcAddress(Hdll, 'hook'); hook(true, Form1.Handle); end; procedure TForm1.WndProc(var Msg: TMessage); begin inherited ; if Msg.Msg = WM_MYKEYHOOK then begin If Msg.wParam = VK_F8 then Begin //ShowMessage('Нажата F8'); Exit; End; If Msg.WParam = VK_F5 then Begin //ShowMessage('Нажата F5'); Exit; End; If Msg.WParam = VK_ESCAPE then Begin //ShowMessage('Нажата ESC'); Exit; End; End; end; procedure TForm1.FormDestroy(Sender: TObject); var Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall; begin //Удаляем хук @hook:= nil; @hook:=GetProcAddress(Hdll, 'hook'); hook(false, Form1.Handle); end; end. ========================================================== библиотека ========================================================== library keyhook; uses SysUtils, Windows, Messages, Forms; var CurHook:HWND; WM_MYKEYHOOK:Cardinal; //Процедура обработки function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall; Var AppWnd:HWND; Begin if code < 0 then begin Result:= CallNextHookEx(CurHook, Code, wParam, lParam); Exit; end; CallNextHookEx(CurHook, Code, wParam, lParam); Result:= 0; if ((lParam and KF_UP)=0) and ((wParam=VK_F5)or(wParam=VK_F8)or(wParam=VK_ESCAPE)) then begin AppWnd:= GetForegroundWindow(); SendMessage(HWND_BROADCAST, WM_MYKEYHOOK, wParam, AppWnd); end; end; {Процедура установки HOOK-а} procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall; begin if switch=true then begin {Устанавливаю HOOK, если он не установлен (switch=true). } CurHook:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0); if CurHook <> 0 then MessageBox(0, 'KEYBOARD HOOK установлен !', 'Message from keyhook.dll', 0) else MessageBox(0, 'HOOK установить не удалось !', 'Message from keyhook.dll', 0); end else begin {Удаляю функцию-фильтр, если она установлена (т.е. switch=false). } if UnhookWindowsHookEx(CurHook) then MessageBox(0, 'HOOK снят !', 'Message from keyhook.dll', 0) else MessageBox(0, 'HOOK снять не удалось !', 'Message from keyhook.dll', 0); end; end; exports hook; begin {регестрируем свой тип сообщения в системе} WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK'); end. Последний раз редактировалось Admin, 15.10.2009 в 12:34. |
#2
|
||||
|
||||
Собственно исправлять практически ничего не пришлось И срабатывала ловушка не 2 раза, а оч-оч много раз.
Держи код своей ловушки Код:
library HookLib; uses SysUtils, Windows, Messages, Forms,Ariphm; var CurHook:HWND; WM_MYKEYHOOK:Cardinal; //Процедура обработки function KeyboardProc(code : integer; wParam : word; lParam : longint) : longint; stdcall; Var AppWnd:HWND; Begin if code < 0 then begin Result:= CallNextHookEx(CurHook, Code, wParam, lParam); Exit; end; CallNextHookEx(CurHook, Code, wParam, lParam); Result:= 0; if ((lParam and KF_UP)=0) and ((wParam=VK_F5)or(wParam=VK_F8)or(wParam=VK_ESCAPE)) then begin if Byte(LParam shr 24)<$80 then //обрабатываем только нажатие begin AppWnd:= GetForegroundWindow(); SendMessage(AppWnd,WM_MYKEYHOOK,wParam,lParam); // SendMessage(HWND_BROADCAST, WM_MYKEYHOOK, wParam, AppWnd); CallNextHookEx(CurHook, Code, wParam, lParam); end; end; end; {Процедура установки HOOK-а} procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall; begin if switch=true then begin {Устанавливаю HOOK, если он не установлен (switch=true). } CurHook:= SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, HInstance, 0); if CurHook <> 0 then MessageBox(0, 'KEYBOARD HOOK установлен !', 'Message from keyhook.dll', 0) else MessageBox(0, 'HOOK установить не удалось !', 'Message from keyhook.dll', 0); end else begin {Удаляю функцию-фильтр, если она установлена (т.е. switch=false). } if UnhookWindowsHookEx(CurHook) then MessageBox(0, 'HOOK снят !', 'Message from keyhook.dll', 0) else MessageBox(0, 'HOOK снять не удалось !', 'Message from keyhook.dll', 0); end; end; exports hook; begin {регестрируем свой тип сообщения в системе} WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK'); end. Модуль Ariphm можно скачать тут (самый первый исходник) Ловушку можешь даж не смотреть ибо глючная она...исправлю скоро по-новой выложу Да, и вот это: Цитата:
Delphi в Internet - блог о программировании. Малоизвестные и редко обсуждаемые темы программирования на Delphi Последний раз редактировалось Vlad55, 17.10.2009 в 16:48. |
#3
|
|||
|
|||
Спасибо за помощь.
|