Установка ловушки для клавиатуры

Delphi , ОС и Железо , Клавиши

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

// 1. Library Code for a Key Hook DLL 


library HookLib;

 uses
   madExcept,
   Windows,
   Messages,
   SysUtils;

 type
   PHookRec = ^THookRec;
   THookRec = record
     AppHnd: Integer;
     MemoHnd: Integer;
   end;

 var
   Hooked: Boolean;
   hKeyHook, hMemo, hMemFile, hApp: HWND;
   PHookRec1: PHookRec;

 function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
 var
   KeyState1: TKeyBoardState;
   AryChar: array[0..1] of Char;
   Count: Integer;
 begin
   Result := 0;
   if Code = HC_NOREMOVE then Exit;
   Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
   {I moved the CallNextHookEx up here but if you want to block 
   or change any keys then move it back down}
   if Code < 0 then
     Exit;

   if Code = HC_ACTION then
   begin
     if ((KeyStroke and (1 shl 30)) <> 0) then
       if not IsWindow(hMemo) then
       begin
        {I moved the OpenFileMapping up here so it would not be opened 
        unless the app the DLL is attatched to gets some Key messages}
         hMemFile  := OpenFileMapping(FILE_MAP_WRITE, False, 'Global7v9k');
         PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
         if PHookRec1 <> nil then
         begin
           hMemo := PHookRec1.MemoHnd;
           hApp  := PHookRec1.AppHnd;
         end;
       end;
     if ((KeyStroke and (1 shl 30)) <> 0) then
     begin
       GetKeyboardState(KeyState1);
       Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);
       if Count = 1 then
       begin
         SendMessage(hMemo, WM_CHAR, Ord(AryChar[0]), 0);
         {I included 2 ways to get the Charaters, a Memo Hnadle and 
         a WM_USER+1678 message to the program}
         PostMessage(hApp, WM_USER + 1678, Ord(AryChar[0]), 0);
       end;
     end;
   end;
 end;


 function StartHook(MemoHandle, AppHandle: HWND): Byte; export;
 begin
   Result := 0;
   if Hooked then
   begin
     Result := 1;
     Exit;
   end;
   if not IsWindow(MemoHandle) then
   begin
     Result := 4;
     Exit;
   end;
   hKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookFunc, hInstance, 0);
   if hKeyHook > 0 then
   begin
     {you need to use a mapped file because this DLL attatches to every app 
     that gets windows messages when it's hooked, and you can't get info except 
     through a Globally avaiable Mapped file}
     hMemFile := CreateFileMapping($FFFFFFFF, // $FFFFFFFF gets a page memory file 
      nil,                // no security attributes 
      PAGE_READWRITE,     // read/write access 
      0,                  // size: high 32-bits 
      SizeOf(THookRec),   // size: low 32-bits 
      //SizeOf(Integer), 
      'Global7v9k');    // name of map object 
    PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
     hMemo := MemoHandle;
     PHookRec1.MemoHnd := MemoHandle;
     hApp := AppHandle;
     PHookRec1.AppHnd := AppHandle;
     {set the Memo and App handles to the mapped file}
     Hooked := True;
   end
   else
     Result := 2;
 end;

 function StopHook: Boolean; export;
 begin
   if PHookRec1 <> nil then
   begin
     UnmapViewOfFile(PHookRec1);
     CloseHandle(hMemFile);
     PHookRec1 := nil;
   end;
   if Hooked then
     Result := UnhookWindowsHookEx(hKeyHook)
   else
     Result := True;
   Hooked := False;
 end;

 procedure EntryProc(dwReason: DWORD);
 begin
   if (dwReason = Dll_Process_Detach) then
   begin
     if PHookRec1 <> nil then
     begin
       UnmapViewOfFile(PHookRec1);
       CloseHandle(hMemFile);
     end;
     UnhookWindowsHookEx(hKeyHook);
   end;
 end;

 exports
   StartHook,
   StopHook;

 begin
   PHookRec1 := nil;
   Hooked := False;
   hKeyHook := 0;
   hMemo := 0;
   DLLProc := @EntryProc;
   EntryProc(Dll_Process_Attach);
 end.


 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 2. Code from the calling Program
 {this program get's the Char from the DLL in 2 ways, 
  as a Char message to a Memo and as a DLLMessage WM_USER+1678}
 ---


 unit Unit1;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;

 type
   TForm1 = class(TForm)
     but_StartHook: TButton;
     but_StopHook: TButton;
     label1: TLabel;
     Memo1: TMemo;
     procedure but_StartHookClick(Sender: TObject);
     procedure but_StopHookClick(Sender: TObject);
   private
     { Private declarations }
     hLib2: THandle;
     DllStr1: string;
     procedure DllMessage(var Msg: TMessage); message WM_USER + 1678;
   public
     { Public declarations }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 procedure TForm1.DllMessage(var Msg: TMessage);
 begin
   if (Msg.wParam = 8) or (Msg.wParam = 13) then Exit;
   {the 8 is the Backspace and the 13 if the Enter key, You'll need to 
  do some special handleing for a string}
   DllStr1 := DllStr1 + Chr(Msg.wParam);
   label1.Caption := DllStr1;
 end;

 procedure TForm1.but_StartHookClick(Sender: TObject);
 type
   TStartHook = function(MemoHandle, AppHandle: HWND): Byte;
 var
   StartHook1: TStartHook;
   SHresult: Byte;
 begin
   hLib2 := LoadLibrary('HookLib.dll');
   @StartHook1 := GetProcAddress(hLib2, 'StartHook');
   if @StartHook1 = nil then Exit;
   SHresult := StartHook1(Memo1.Handle, Handle);
   if SHresult = 0 then ShowMessage('the Key Hook was Started, good');
   if SHresult = 1 then ShowMessage('the Key Hook was already Started');
   if SHresult = 2 then ShowMessage('the Key Hook can NOT be Started, bad');
   if SHresult = 4 then ShowMessage('MemoHandle is incorrect');
 end;

 procedure TForm1.but_StopHookClick(Sender: TObject);
 type
   TStopHook = function: Boolean;
 var
   StopHook1: TStopHook;
   hLib21: THandle;
 begin
   @StopHook1 := GetProcAddress(hLib2, 'StopHook');
   if @StopHook1 = nil then
   begin
     ShowMessage('Stop Hook DLL Mem Addy not found');
     Exit;
   end;
   if StopHook1 then
     ShowMessage('Hook was stoped');
   FreeLibrary(hLib2);
   {for some reason in Win XP you need to call FreeLibrary twice 
  maybe because you get 2 functions from the DLL? ?}
   FreeLibrary(hLib2);
 end;


 end.

Программа на Delphi, которая позволяет устанавливать и управлять хуком клавиатуры в других приложениях. Программа состоит из двух частей: динамической библиотеки (DLL) и основного программного обеспечения.

DLL (HookLib.dll)

DLL содержит следующие функции:

• KeyHookFunc: Это callback-функция, которая вызывается каждый раз, когда происходит событие клавиатуры. Она проверяет, является ли это событие связанным с нажатием или отпуском клавиши, и если так, то отправляет символ в текстовое поле (memo control) основного программного обеспечения.
• StartHook: Функция настройки хука клавиатуры, которая вызывает SetWindowsHookEx и выделяет память для записи хука. Она также инициализирует handle memo и app handle.
• StopHook: Функция остановки хука клавиатуры, которая отключает window procedure и освобождает выделенную память.

Основное программное обеспечение (Unit1)

Основное программное обеспечение - это форма Delphi, содержащая два кнопки: but_StartHook и but_StopHook. Когда вы нажимаете на but_StartHook, она загружает DLL, вызывает StartHook для настройки хука клавиатуры и отображает сообщение об ошибке, если хук был успешно запущен. Когда вы нажимаете на but_StopHook, она останавливает хук клавиатуры, вызывая StopHook, и освобождает DLL.

Программа также содержит текстовое поле (memo control) (Memo1), которое получает символы от DLL. Она также имеет метку (label1), которая отображает текст, введенный в текстовом поле.

Замечания

• Код использует библиотеку madExcept для обработки исключений.
• Функция StartHook возвращает код ошибки, который отображается в сообщении об ошибке, если произошла ошибка.
• Функция StopHook также возвращает булевое значение, указывающее, был ли хук остановлен успешно.
• Программа использует функции LoadLibrary и GetProcAddress, чтобы загрузить DLL и получить адреса ее экспортированных функций.
• Программа использует функцию FreeLibrary, чтобы освободить DLL, но она вызывает ее дважды в but_StopHookClick, что может не быть необходимым.

Предложения по улучшению

• Добавьте обработку ошибок для случаев, когда DLL не может быть загружена или выполнена.
• Рассмотрите использование более надежного метода хранения и извлечения данных из текстового поля, например, использования безопасной очереди.
• Улучшите пользовательский интерфейс, добавив более информативные сообщения об ошибке и предоставляя обратную связь при запуске или остановке хука клавиатуры успешно.
• Рассмотрите добавление опций для настройки поведения хука клавиатуры, таких как фильтрация определенных клавиш или символов.

Установка ловушки для клавиатуры позволяет получать информацию о вводе символов в любом приложении, к которому она прикреплена.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Клавиши ::