Перехват (Hook) клавиатуры (программа Sendkeys)

Code:

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* //

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.