program Code;

uses
 Crt;

var
 Done: Boolean;

begin
 Done := False;
 repeat

   { сделать что-нибудь полезное... }

   while KeyPressed do
     case ReadKey of
     ' ':
       { обработать нажатие клавиши "пробел" };
     #27:
       Done := True;
     #0:
       { обработка расширенных кодов BIOS }
       case ReadKey of
       #72:
         { обработать нажатие клавиши "вверх" };
       #75:
         { обработать нажатие клавиши "влево" };
       #77:
         { обработать нажатие клавиши "вправо" };
       #80:
         { обработать нажатие клавиши "вниз" };
       end;
     end
 until Done;
end.

{From: Valery Votintsev 2:5021/22}
{Alt, Shift, Ctrl test for 0040:0017 keyboard status}
Uses CRT;
Const
 RightShift    = $0001;
 LeftShift     = $0002;
 AnyCtrl       = $0004;
 AnyAlt        = $0008;
 ScrollActive  = $0010;
 NumLockActive = $0020;
 CapsLockActive= $0040;
 InsActive     = $0080;
 LeftCtrl      = $0100;
 LeftAlt       = $0200;
 SysReq        = $0400;
 PauseKey      = $0800;
 ScrollLock    = $1000;
 NumLock       = $2000;
 CapsLock      = $4000;
 Insert        = $8000;

const hex_num:array [0..15] of char='0123456789ABCDEF';

var
 key:char;                {код нажатой клавиши}
 flags:word;              {флаги состояния клавиатуры}
 newflags:word;

function word2hex(w:word):string;
{перевод в 16-ричное число}
var
b:array[1..2] of byte absolute w;
begin
 word2hex:=hex_num[b[2] shr 4]+hex_num[b[2] and $0F] +
           hex_num[b[1] shr 4]+hex_num[b[1] and $0F]
end;

function GetFlags:Word;
{Считывает состояние флагов спец.клавиш}
begin
 GetFlags:=memW[0:$417];
end;

function AnyKeyEvent:boolean;
begin
 AnyKeyEvent:= (KeyPressed or (newflags<>flags));
end;

function Pressed(lock:word):Boolean;
{Проверяет, нажата ли спец.клавиша с кодом LOCK}
begin
 if (flags and word(lock))<>0 then Pressed:=true
                        else Pressed:=false;
end;

Procedure WriteKeyCode;
begin
 TextAttr:=White;
 If KeyPressed then begin
   key:= ReadKey;                  {читаем код              }
   if Key = #0 then begin          {код оказался расширенным}
      Write(Ord(Key):3,',');       {печатаем нулевой код    }
      key:= ReadKey;               {читаем расширенный код  }
   end;
   Write(Ord(Key):3);              {печатаем основной код   }
 end
 else write('       ');
end;

Procedure WriteFlags;
begin
   TextAttr:=LightGray;
   Write(' Flags:',word2hex(memW[Seg0040:$17]));
   {Теперь печатаем флаги спец.клавиш}
   TextAttr:=Cyan;
   If Pressed(RightShift)     then Write(' RightShift');
   If Pressed(LeftShift )     then Write(' LeftShift');
   If Pressed(AnyAlt    )     then Write(' AnyAlt');
   If Pressed(AnyCtrl   )     then Write(' AnyCtrl');
   If Pressed(LeftCtrl  )     then Write(' LeftCtrl');
   If Pressed(LeftAlt   )     then Write(' LeftAlt');
   If Pressed(SysReq    )     then Write(' SysReq');
   If Pressed(PauseKey  )     then Write(' Pause');
   If Pressed(ScrollLock)     then Write(' ScrollLock');
   If Pressed(NumLock   )     then Write(' NumLock');
   If Pressed(CapsLock  )     then Write(' CapsLock');
   If Pressed(Insert    )     then Write(' Insert');

   {Теперь печатаем состояние переключателей}
   TextAttr:=Yellow;
   If Pressed(ScrollActive  ) then Write(' ScrollLockActive');
   If Pressed(NumLockActive ) then Write(' NumLockActive');
   If Pressed(CapsLockActive) then Write(' CapsLockActive');
   If Pressed(InsActive     ) then Write(' InsActive');
   Writeln;
   TextAttr:=LightGray;
end;

begin
 while keypressed do readkey;      {Очистить буфер клавиатуры}
 flags:=GetFlags;                  {начальное состояние флагов}
 repeat
   newflags:=GetFlags;             {новое состояние флагов}
   If AnyKeyEvent then begin       {если чего-нибудь нажато}
      WriteKeyCode;
      flags:=newflags;             {запомнить состояние флагов}
      WriteFlags;
   end;
 until Key = #27;                  {Цикл, пока не нажмем Esc}
 while keypressed do readkey;      {Очистить буфер клавиатуры}
end.