Тема: Hook
Показать сообщение отдельно
  #2  
Старый 17.10.2009, 01:56
Аватар для Vlad55
Vlad55 Vlad55 вне форума
Прохожий
 
Регистрация: 17.10.2009
Сообщения: 17
Версия Delphi: Delphi XE
Репутация: 10
По умолчанию

Собственно исправлять практически ничего не пришлось И срабатывала ловушка не 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 можно скачать тут (самый первый исходник) Ловушку можешь даж не смотреть ибо глючная она...исправлю скоро по-новой выложу

Да, и вот это:
Цитата:
((lParam and KF_UP)=0) and
можно удалить, т.к. смысла в этом нету сейчас никакого
__________________
Delphi в Internet - блог о программировании. Малоизвестные и редко обсуждаемые темы программирования на Delphi
Ответить с цитированием