program Project1;
uses
 Forms,
 Unit1 in '..\Hooks1\Unit1.pas' {Form1};
{$R *.RES}
begin
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.
// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* //

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 := CallHookEx(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.

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* //
object Form1: TForm1
 Left = 200
   = 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
   = 68
  Width = 32
  Height = 13
  Caption = 'Label1'
 end
end

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* //
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.