Виртуальная библиотека Delphi

Существуют приложения, которым необходимо перехватывать все нажатия клавиш в Windows, даже если в данный момент активно другое приложение. Это может быть, например, программа, переключающая раскладку клавиатуры, резидентный словарь или программа, выполняющая иные действия по нажатию "горячей" комбинации клавиш. Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка — это пользовательская процедура, которая будет обрабатывать указанное событие. Основное здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на клавиатуре, проверяет их и, если это клавиши "+" или "-", посылает соответствующее сообщение в конкретное приложение (окно). Окно ищется по имени его класса ("TForm1") и заголовку (caption, "XXX").

{текст библиотеки}

library SendKey;

uses

WinTypes, WinProcs, Messages;

const

{пользовательские сообщения}

wm_NextShow_Event = wm_User + 133;

wm_PrevShow_Event = wm_User + 134;

{handle для ловушки}

HookHandle: hHook = 0;

var

SaveExitProc : Pointer;

{собственно ловушка}

function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export;

var

H: HWND;

begin

{если Code>=0, то ловушка может обработать событие}

if Code >= 0 then

begin

   {это те клавиши?}

   if ((wParam = VK_ADD)or(wParam = VK_SUBTRACT)) and

(lParam and $40000000 = 0)

   then begin

     {ищем окно по имени класса и по заголовку}

     H := FindWindow('TForm1', 'XXX');

     {посылаем сообщение}

     if wParam = VK_ADD then

       SendMessage(H, wm_NextShow_Event, 0, 0)

     else

       SendMessage(H, wm_PrevShow_Event, 0, 0);

   end;

  {если 0, то система должна дальше обработать это событие}

  {если 1 - нет}

  Result:=0;

end

else

  {если Code<0, то нужно вызвать следующую ловушку}

   Result := CallNextHookEx(HookHandle,Code, wParam, lParam);

end;

{при выгрузке DLL надо снять ловушку}

procedure LocalExitProc; far;

begin

if HookHandle<>0 then

begin

   UnhookWindowsHookEx(HookHandle);

   ExitProc := SaveExitProc;

end;

end;

{инициализация DLL при загрузке ее в память}

begin

{устанавливаем ловушку}

HookHandle := SetWindowsHookEx(wh_Keyboard, Key_Hook,

   hInstance, 0);

if HookHandle = 0 then

   MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok)

else begin

  SaveExitProc := ExitProc;

  ExitProc := @LocalExitProc;

end;

end.

Размер такой DLL в скомпилированном виде будет около 3Кб, поскольку в ней не используются объекты из VCL.

Далее приведен код модуля в Delphi, который загружает DLL и обрабатывает сообщения от ловушки, просто отображая их в Label1.

unit Unit1;

interface

uses

SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,

Controls,Forms,Dialogs,StdCtrls;

{пользовательские сообщения}

const

wm_NextShow_Event = wm_User + 133;

wm_PrevShow_Event = wm_User + 134;

type

  TForm1 = class(TForm)

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

  private

{обработчики сообщений}

    procedure WM_NextMSG (Var M : TMessage); message wm_NextShow_Event;