Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.222.115.120] |
|
Сообщ.
#1
,
|
|
|
Бывает неудобно использовать локальную ловушку в объектной программе. Для того чтобы взаимодействавать с обектом нужно гдето хранить глобальную переменную под этот объект. а бывают такие случаи когда это затруднительно зделать (и тогда начинаются извращения);
я для себя набросал модуль который позволяет метод подсунуть SetWindowsHookEx TForm1 = class(TForm) .. procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private Hook: HHOOK; HookMetod: PHookMetod; procedure GKeyboard(var Kbd: TKeyboard); ... procedure TForm1.FormCreate(Sender: TObject); begin HookMetod := MethodMakeToCall(GKeyboard); hook := SetWindowsHookEx(WH_KEYBOARD, HookMetod, HInstance, GetCurrentThreadId); end; procedure TForm1.FormDestroy(Sender: TObject); begin UnhookWindowsHookEx(hook); FreeCall(HookMetod); end; procedure TForm1.GKeyboard(var msg: TMessage); begin .... end; ... private Hook: PHookMetod; ... procedure TForm1.FormCreate(Sender: TObject); begin hook := SetHook(WH_KEYBOARD, GKeyboard, HInstance, GetCurrentThreadId); // ставим ловушку end; procedure TForm1.FormDestroy(Sender: TObject); begin UnHook(Hook); // снимаем ловушку end; procedure TForm1.GKeyboard(var Msg: TMessage); begin with Msg do begin Result := CallNextHookEx(GetHook(Hook), Msg, WParam, LParam); // даем поработать и другим //функция GetHook возвращает хендл ловушки из структуры PHookMetod //если ловушка была создана не SetHook то он будет нулевым или заполнен левыми данными. if Msg = HC_ACTION then begin if Byte(LParam shr 24) <> $C0 then begin Label1.Caption := Chr(WParam shr 32); end; end; end; end; в прикремленном архиве модуль UHook и пример пс. не пытайтесь это всунуть в глобальную ловушку Прикреплённый файлUHook.zip (2.38 Кбайт, скачиваний: 230) |
Сообщ.
#2
,
|
|
|
хотя можна и глобально поцепить (но без переменной всеравно не обойтись. хотя изврат получается приколькный (может комуто и пригодится ))) ))
library Project2; uses Windows, Messages, UHook in 'UHook.pas'; type TTestOb = class(TObject) private Hook: PHookMetod; procedure GKeyboard(var Msg: TMessage); public constructor Create; destructor Destroy; override; end; var Test: TTestOb; { TTestOb } constructor TTestOb.Create; begin Hook := MethodMakeToCall(GKeyboard); end; destructor TTestOb.Destroy; begin FreeCall(Hook); inherited; end; procedure TTestOb.GKeyboard(var Msg: TMessage); begin MessageBeep(0); Msg.Result := 1; // блокируем все )))) end; procedure CallHook; asm push eax push eax mov eax, Test mov eax, [eax].TTestOb.Hook; mov [esp+4], eax pop eax end; function Start: HHOOK; begin Result := SetWindowsHookEx(WH_KEYBOARD, @CallHook, HInstance, 0); end; procedure DLLEntryPoint(dwReason: DWord); stdcall; begin case dwReason of DLL_PROCESS_ATTACH: Test := TTestOb.Create; DLL_PROCESS_DETACH: Test.Free; end; end; exports start; begin DLLProc:= @DLLEntryPoint; DLLEntryPoint(DLL_PROCESS_ATTACH); end. function Start: HHOOK; stdcall; external 'Project2.dll'; implementation {$R *.dfm} var H: THandle; procedure TForm1.FormCreate(Sender: TObject); begin H := Start; end; procedure TForm1.FormDestroy(Sender: TObject); begin UnhookWindowsHookEx(H) end; |