Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=276828&view=findpost&p=2309841 Sun, 12 Jul 2009 12:42:37 +0000 Подсунуть ловушке метод вместо функции. https://forum.sources.ru/index.php?showtopic=276828&view=findpost&p=2309841
    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;
естественно нужно позаботится о глобальной передачи хендла ловушки, но это к данному примеру не относится.]]> ViktorXP Системные функции, WinAPI, работа с железом https://forum.sources.ru/index.php?showtopic=276828&view=findpost&p=2309727 Sun, 12 Jul 2009 11:35:48 +0000 Подсунуть ловушке метод вместо функции. https://forum.sources.ru/index.php?showtopic=276828&view=findpost&p=2309727
я для себя набросал модуль который позволяет метод подсунуть 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;
Но было лень хранить две переменных посему я набросал оболочку над SetWindowsHookEx

    ...
      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 и пример

пс. не пытайтесь это всунуть в глобальную ловушку :D]]> ViktorXP Системные функции, WinAPI, работа с железом