{$G+}
UNIT CoolKey; {Удобная, а главное быстрая работа с клавиатурой.
               Большие возможности}
               INTERFACE
{$C FIXED PRELOAD PERMANENT}
Uses Dos;
{$F+,S-,W-}
Var
  ifCaps,ifScroll,ifNum : boolean;
  CodeBuffer            : array [0..255] of byte;
  PressBuffer           : array [0..255] of boolean;
  BufB,BufE             : byte;

Type
EScanCode = (SC_BUFFULL, SC_ESCAPE, SC_1, SC_2, SC_3, SC_4, SC_5 ,SC_6, SC_7,
             SC_8, SC_9, SC_0, SC_MINUS, SC_EQUAL, SC_BACKSPACE, SC_TAB,
             SC_Q,SC_W,SC_E,SC_R,SC_T,SC_Y,SC_U,SC_I,SC_O,SC_P,SC_LBR,SC_RBR,
             SC_ENTER,SC_LCTRL,SC_A,SC_S,SC_D,SC_F,SC_G,SC_H,SC_J,SC_K,SC_L,
             SC_SEMICOLON,SC_AMPERSAND,SC_TILDE,SC_LSHIFT,SC_BACKSLASH,
             SC_Z,SC_X,SC_C,SC_V,SC_B,SC_N,SC_M,SC_COMMA,SC_PERIOD,SC_SLASH,
             SC_RSHIFT,SC_GREY_MUL,SC_LALT,SC_SPACE,SC_CAPSLOCK,SC_F1,SC_F2,
             SC_F3,SC_F4,SC_F5,SC_F6,SC_F7,SC_F8,SC_F9,SC_F10,SC_NUMLOCK,
             SC_SCROLLLOCK,SC_PAD_HOME,SC_PAD_UP,SC_PAD_PGUP,SC_GRAY_SUB,
             SC_PAD_LEFT,SC_PAD_5,SC_PAD_RIGHT,SC_GRAY_ADD,SC_PAD_END,
             SC_PAD_DOWN,SC_PAD_PGDN,SC_PAD_INS,SC_PAD_DEL, {Primary over}

             SC_SYSREQ,SC_NOTE1_F11,SC_L102,SC_F11,SC_F12,SC_NOTE1_F15,
             SC_PA1,SC_LWin,SC_RWIN,SC_MENU,SC_5E,SC_5F,SC_60,SC_61,SC_62,
             SC_F16,SC_F17,SC_F18,SC_F19,SC_F20,SC_F21,SC_F22,SC_F23,SC_F24,
             SC_6C,SC_ERASEOEF,SC_6E,SC_COPYPLAY,SC_70,SC_71,SC_CrSel,SC_DELTA,
             SC_EXSEL,SC_75,SC_CLEAR,SC_77,SC_78,SC_79,SC_7A,SC_7B,SC_7C,SC_7D,
             SC_7E,SC_7F,
             {ADDITION TO TABLE, prefixed by 0E0h }
SC_80,SC_81,SC_82,SC_83,SC_84,SC_85,SC_86,SC_87,SC_88,SC_89,SC_8A,SC_8B,SC_8C,SC_8D,SC_8E,SC_8F,
SC_90,SC_91,SC_92,SC_93,SC_94,SC_95,SC_96,SC_97,SC_98,SC_99,SC_9A,SC_9B,SC_PAD_ENTER,SC_RCTRL,SC_9E,SC_9F,
SC_A0,SC_A1,SC_A2,SC_A3,SC_A4,SC_A5,SC_A6,SC_A7,SC_A8,SC_A9,SC_PREFIX,SC_AB,SC_AC,SC_AD,SC_AE,SC_AF,
SC_B0,SC_B1,SC_B2,SC_B3,SC_B4,SC_PAD_DIV,SC_B6,SC_PRINTSCREEN,SC_RALT,SC_B9,SC_BA,SC_BB,SC_BC,SC_BD,SC_BE,SC_BF,
SC_C0,SC_C1,SC_C2,SC_C3,SC_C4,SC_C5,SC_C6,SC_HOME,SC_UP,SC_PGUP,SC_CA,SC_LEFT,SC_CC,SC_RIGHT,SC_CE,SC_END,
SC_DOWN,SC_PGDN,SC_INSERT,SC_DELETE,SC_D4,SC_D5,SC_D6,SC_D7,SC_D8,SC_D9,SC_DA,SC_DB,SC_DC,SC_DD,SC_DE,SC_DF,
SC_E0,SC_E1,SC_E2,SC_E3,SC_E4,SC_E5,SC_E6,SC_E7,SC_E8,SC_E9,SC_EA,SC_EB,SC_EC,SC_ED,SC_EE,SC_EF,
SC_F0,SC__F1,SC__F2,SC__F3,SC__F4,SC__F5,SC__F6,SC__F7,SC__F8,SC__F9,SC_FA,SC_FB,SC_FC,SC_FD,SC_FE,SC_FF);

TKeyTable = array [EScanCode] of boolean;
PKeyTable = ^TKeyTable;  {Главный тип модуля, массив нажатых кнопок}

CONST
 SC_NAME : array [EScanCode] of string [15] =
  ('','Escape','1','2','3','4','5','6','7','8','9','0','Substract',
   'Equal','Backspace','Tab','Q','W','E','R','T','Y','U','I','O','P',
   'Left Bracket','Right Bracket','Enter', 'Left Ctrl','A','S','D','F','G','H',
   'J','K','L','Semicolon','Ampersand','Tilde','Left Shift','Back Slash','Z',
   'X','C','V','B','N','M',
   'Comma','Period','Slash','Right Shift','Grey *','Left Alt',
   'SpaceBar','CapsLock','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10',
   'NumLock','ScrollLock','Pad Home','Pad Up','Pad PgUp','Gray -','Pad Left',
   'Pad 5','Pad Right','Gray +','Pad End','Pad Down','Pad PgDn','Pad Ins',
   'Pad Del','','','','F11','F12','','','Left Win','Right Win','Menu','5E','5F',
   '60','61','62','63','64','65','66','67','68','69','6A','6B','6C','6D','6E',
   '6F','70','71','72','73','74','75','76','77','78','79','7A','7B','7C','7D',
   '7E','7F', {Full Original PC/XT Keyboard}
   {Begining of 101-key}
   '80','81','!','@','#','$','%','^','&','*','(',')','_','+','8E','8F','90','91',
   '92','93','94','96','96','97','98','99','9A','9B','Pad Enter', 'Right Ctrl',
   '9E','9F','A0','A1','A2','A3','A4','A5','A6','A7','A8','A9','Prefix1','AB',
   'AC','AD','AE','AF','B0','B1','B2','B3','B4','Pad Div','Prefix2','Printscreen',
   'Right Alt','B9','BA','BB','BC','BD','BE','BF','C0','C1','C2','C3','C4','C5',
   'C6','Home','Up','PgUp','CA','Left','CC','Right','CE','End','Down','PgDn',
   'Insert','Delete','D4','D5','D6','D7','D8','D9','DA','Left Win','Right Win',
   'Menu','DE','DF','E0','E1','E2','E3','E4','E5','E6','E7','E8','E9','EA',
   'EB','EC','ED','EE','EF','F0','F1','F2','F3','F4','F5','F6','F7','F8','F9',
   'FA','FB','FC','FD','FE','FF');


Function InitKeyboard : PKeyTable; {Перехват INT09. Возвр. ук на таблицу}
Function GetChar(aSC : byte):Char;
Function GetScanCode(var aC:EScanCode; var Pressed:Boolean):Boolean;
Procedure CloseKeyboard; {Возврат прерывания. Выход}

                IMPLEMENTATION
const
 gInited  : boolean = false;
 lastPref : byte = 0;

var
 KeyTable : TKeyTable;
 OldINT09 : Pointer;


Procedure NewInt09;far;assembler;
asm
   push ax
   push bx
   push si
   push es
   push cx
   push dx

   xor bx, bx
   xor ax, ax
   in  al, 60h

   cmp al, 0E0h
   jz @@SETPREF

   mov cl, al

   mov bl, al                   {Save real value}
   and bl, 7Fh
   add bl, lastPref             {Calculate table offset}
   mov si, offset KeyTable      {Load table}
   add si, bx                   {Add index}

   shr al, 7
   not al
   and al, 1
   mov ds:[si], al

   mov si, offset CodeBuffer
   xor dx, dx
   mov dl, BufE
   cmp dl, 255
   jz  @@HERE
   add si, dx
   mov ds:[si], bl
   mov si, offset PressBuffer
   add si, dx
   mov ds:[si], al
   inc dx
   mov byte ptr BufE, dl

@@HERE:
   mov lastPref, 0

   cmp cl, 3Ah
   jz @@CAPS
   cmp cl, 45h
   jz @@NUM
   cmp cl, 46h
   jz @@SCROLL
   jmp @@OUT2


@@CAPS:
   mov al, ifCaps
   not al
   and al, 1
   mov byte ptr ifCaps, al

   jmp @@OUT
@@NUM:
   mov al, ifNum
   not al
   and al, 1
   mov byte ptr ifNum, al
   jmp @@OUT
@@SCROLL:
   mov al, ifScroll
   not al
   and al, 1
   mov byte ptr ifScroll, al
   jmp @@OUT

@@SETPREF:
   mov lastPref, 80h            {This equals offset of extended keys}
   jmp @@out2

@@OUT:
   mov ah, byte ptr ifCaps    {Create lights}
   shl ah, 1                  {bits}
   mov al, byte ptr ifNum
   or ah, al
   shl ah, 1
   mov al, byte ptr ifScroll
   or ah, al
   
   mov al, ah
   shl al, 4
   push 0
   pop es
   mov byte ptr es:[417h], al

   mov cx, 0         {Wait controller}
@@WL1:               {}
   in al, 64h        {}
   and al, 2h        {}
   loopnz @@WL1      {}

   mov al, 0edh       {We are going to change lights}
   out 60h, al       {}

   mov cx, 0
@@WL2:
   in al, 64h
   and al, 2h
   loopnz @@WL2

   mov al, ah        {Here we got our lights}
   out 60h, al

@@OUT2:
   pop dx
   pop cx
   pop es
   pop si
   pop bx
   in al, 61h           { Get value of keyboard control lines}
   mov ah, al           {  save it                           }
   or al, 80h           { set the "enable kbt" bit           }
   out 61h, al          {  and write it out the contorl port }
   xchg ah, al          { fetch the original value           }
   out 61h, al          {  and write it back                 }

   mov al, 20h          { Send End-Of-Interrupt signal       }
   out 20h, al          {  to the 8259 Interrupt Controller  }
   pop ax
   iret
end;{NewInt09}
{-------------------------------}
Function GetScanCode(var aC:EScanCode; var Pressed:Boolean):Boolean;
begin
  if BufB <> BufE then
   begin
    aC := EScanCode(CodeBuffer[BufB]);
    Pressed := PressBuffer[BufB];
    inc(BufB);
    GetScanCode := true;
   end
  else
   begin
    BufB:=0;
    BufE:=0;
    GetScanCode := false;
   end;
end;
Function InitKeyboard : PKeyTable; {Перехват INT09. Возвр. ук на таблицу}
begin
  if gInited then Exit;
  FillChar(KeyTable,256,0); {Zeroes keys table}
  FillChar(CodeBuffer,256,0); {Zeroes keys table}
  FillChar(PressBuffer,256,0); {Zeroes keys table}
  BufB:=0;
  BufE:=0;
  GetIntVec($09,OldINT09);
  SetIntVec($09,Addr(NewINT09));
  gInited := true;
  InitKeyBoard := @KeyTable;
end;{Init keyboard}
{------------------------}
Procedure CloseKeyboard; {Возврат прерывания. Выход}
begin
 if not gInited then exit;
 SetIntVec($09,OldInt09);
 gInited := false;
end;{CloseKeyboard}

Function GetChar(aSC : byte):Char;
begin
  GetChar := #0;
  if EScanCode(aSC) in [SC_Q..SC_P,SC_A..SC_L,SC_Z..SC_M] then
   begin
     if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] or ifCaps then
      GetChar := SC_NAME[EScanCode(aSC)][1]
     else
      GetChar := chr(ord(SC_NAME[EScanCode(aSC)][1]) + $20);
     exit;
   end;

  if EScanCode(aSC) in [SC_1..SC_0] then
   begin
     if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then
      GetChar := SC_NAME[EScanCode(aSC + ord(SC_80))][1]
     else
      GetChar := SC_NAME[EScanCode(aSC)][1];
     exit;
   end;
  case EScanCode(aSC) of
   SC_MINUS: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '_' else GetChar := '-';
   SC_EQUAL: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '+' else GetChar := '=';
   SC_BACKSLASH: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '|' else GetChar := '\';
   SC_LBR: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '{' else GetChar := '[';
   SC_RBR: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '}' else GetChar := '}';
   SC_SEMICOLON: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := ':' else GetChar := ';';
   SC_AMPERSAND: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := ':' else GetChar := '''';
   SC_COMMA: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '<' else GetChar := ',';
   SC_PERIOD: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '>' else GetChar := '.';
   SC_SLASH: if KeyTable[SC_LSHIFT] or KeyTable[SC_RSHIFT] then 
              GetChar := '?' else GetChar := '/';
   SC_SPACE: GetChar := ' ';
  end;
end;
END.