На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Подсунуть ловушке метод вместо функции.
      Бывает неудобно использовать локальную ловушку в объектной программе. Для того чтобы взаимодействавать с обектом нужно гдето хранить глобальную переменную под этот объект. а бывают такие случаи когда это затруднительно зделать (и тогда начинаются извращения);

      я для себя набросал модуль который позволяет метод подсунуть SetWindowsHookEx

      ExpandedWrap disabled
          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

      ExpandedWrap disabled
        ...
          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 -

      Прикреплённый файлПрикреплённый файлUHook.zip (2.38 Кбайт, скачиваний: 230)
        хотя можна и глобально поцепить (но без переменной всеравно не обойтись. хотя изврат получается приколькный (может комуто и пригодится ))) ))
        ExpandedWrap disabled
          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.
        ну и тест.
        ExpandedWrap disabled
          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;
        естественно нужно позаботится о глобальной передачи хендла ловушки, но это к данному примеру не относится.
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0368 ]   [ 17 queries used ]   [ Generated: 28.03.24, 18:54 GMT ]