Вот она! Работающая! С комментариями! Полная версия! Привожу код полностью. Автор Bogachev. Большое человеческое ему спасибо. Старую версию на всякий случай оставляю, авось пригодится.

SendKey - DLL-ка
Project1 - Управляющая программа

Project1.dpr

    program Project1;

uses
Forms, Unit1 in '..\Hooks1\Unit1.pas' {Form1};
{$R *.RES}

begin
Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

SendKey.dpr

    library SendKey;

uses
SysUtils, Classes, Windows, Messages;
const


{пользовательские сообщения} wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136;
{handle для ловушки} HookHandle: hHook = 0;
var
SaveExitProc : Pointer;
{собственно ловушка} function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint;stdcall; export;
var H: HWND;
begin
{если Code>=0, то ловушка может обработать событие} if (Code >= 0) and (lParam and $40000000 = 0) then begin {ищем окно по имени класса и по заголовку (Caption формы управляющей программы должен быть равен 'XXX' !!!!)} H := FindWindow('TForm1', 'XXX');
{это те клавиши?} Case wParam of VK_Left: SendMessage(H, wm_LeftShow_Event, 0, 0); VK_Right: SendMessage(H, wm_RightShow_Event, 0, 0); VK_Up: SendMessage(H, wm_UpShow_Event, 0, 0); VK_Down: SendMessage(H, wm_DownShow_Event, 0, 0); end; {если 0, то система должна дальше обработать это событие} {если 1 - нет} Result:=0; end
else if Code<0 {если Code<0, то нужно вызвать следующую ловушку} then Result := CallNextHookEx(HookHandle,Code, wParam, lParam); end;

{при выгрузке DLL надо снять ловушку}
procedure LocalExitProc; far;
begin
if HookHandle<>0 then begin UnhookWindowsHookEx(HookHandle); ExitProc := SaveExitProc; end; end;

exports Key_Hook;

{инициализация 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.

Unit1.dfm

    object Form1: TForm1
Left = 200 Top = 104 Width = 544 Height = 375 Caption = 'XXX' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 128 Top = 68 Width = 32 Height = 13 Caption = 'Label1' end end

Unit1.pas

    unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

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

const
wm_LeftShow_Event = wm_User + 133; wm_RightShow_Event = wm_User + 134; wm_UpShow_Event = wm_User + 135; wm_DownShow_Event = wm_User + 136;
type
TForm1 = class(TForm) Label1: TLabel;
procedure FormCreate(Sender: TObject);

private //Обработчики сообщений
procedure WM_LeftMSG (Var M : TMessage); message wm_LeftShow_Event;
procedure WM_RightMSG (Var M : TMessage); message wm_RightShow_Event;
procedure WM_UpMSG (Var M : TMessage); message wm_UpShow_Event;
procedure WM_DownMSG (Var M : TMessage); message wm_DownShow_Event; end;

var
Form1: TForm1; P : Pointer;
implementation

{$R *.DFM}

//Загрузка DLL
function Key_Hook(Code: integer; wParam: word; lParam: Longint) : Longint; stdcall; external 'SendKey' name 'Key_Hook';

procedure TForm1.WM_LefttMSG (Var M : TMessage);
begin
Label1.Caption:='Left'; end;

procedure TForm1.WM_RightMSG (Var M : TMessage);
begin
Label1.Caption:='Right'; end;

procedure TForm1.WM_UptMSG (Var M : TMessage);
begin
Label1.Caption:='Up'; end;

procedure TForm1.WM_DownMSG (Var M : TMessage);
begin
Label1.Caption:='Down'; end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{если не использовать вызов процедуры из DLL в программе,
то компилятор удалит загрузку DLL из программы}
P:=@Key_Hook;
end;

end.

[000503]