unit retazce;

interface
function repchar(t1:string;kolko:byte):string;
function left(t:string;kolko:byte):string;
function right(t:string;kolko:byte):string;
function dopznlft(t1:string;t2:char;kolko:byte):string;
function dopznri(t1:string;t2:char;kolko:byte):string;
function dopznlftdl(t1:string;t2:char;kolko:byte):string;
function dopznridl(t1:string;t2:char;kolko:byte):string;
function posit(subst,stri:string;od:byte):byte;
function value(c:string):longint;
function stri(c1:longint):string;
function upstring(t:string):string;
function downstring(t:string):string;
function lefttrim(t:string):string;
function righttrim(t:string):string;
function alltrim(t:string):string;
function center(str:string;dlzka:byte):string;
function hexstr(cis:longint;rozsah:byte):string;
function strl(cis:longint; pocm:byte):string;
function strr(cis:real;pocm,des:byte):string;
function posodzadu(znak:char; t1:string):byte;
function nahrad(t,t1,t2:string):string;
function asciisum(t:string):word;
function nazovkl(kl:word):string;
function poscis(t:string):string;
function preptext(t,nov:string; odp:byte):string;
function aktcas(typ:byte; oddel:char):string;
function bezdiakr(t:string):string;


const
     hexh:array[0..15] of char=('0','1','2','3','4','5','6','7','8','9','A',
     'B','C','D','E','F');
     const dzn:array[1..20,1..2] of byte=((128,65),(129,65),(130,67),(131,68),(132,69),(133,69),(134,73),(135,76),(136,76),
                                          (137,78),(138,79),(139,79),(140,82),(141,82),(142,83),(143,84),(144,85),(145,85),
                                          (146,89),(147,90));
     vahy:array[1..4] of word=(1,16,256,4096);
     pklav=30;
     cisl:array[1..10] of string[2]=('1','2','3','4','5','6','7','8','9','10');
     polohakl:array[1..35] of char=('q','w','e','r','t','y','u','i','o','p',
              '[',']',' ',' ','a','s','d','f','g','h','j','k','l',' ',' ',' ',' ',
               '\','z','x','c','v','b','n','m');
     tklavc:array[1..pklav] of word=($11b,$e08,$f09,$1c0d,$3920,$4700,$4800,$4900,$4b00,$4d00,
             $4f00,$5000,$5100,$5200,$5300,$f00,$300,$71e,$c1f,$e7f,
             $7700,$8400,$7300,$7400,$7500,$7600,$1c0a,$400,$600,$8100);
     tklavk:array[1..pklav] of string[20]=('Esc','Backspace','Tabulator','Enter','Space','Home',#24,'PgUp',#27,#26,
             'End',#25,'PgDn','Ins','Del','Shift Tab','Ctrl 2','Ctrl 6','Ctrl -','Ctrl Backspace',
             'Ctrl Home','Ctrl PgUp','Ctrl '+#27,'Ctrl '+#26,'Ctrl End','Ctrl PgDn',
             'Ctrl Enter','Ctrl Ins','Ctrl del','Alt 0');



implementation
uses
	dos,zaklpr;

function nazovkl(kl:word):string;
var
   t:string;
   i,asc,pos:byte;

begin
     asc:=lo(kl); pos:=hi(kl);
     if asc>31 then t:=chr(asc)
     else
         if asc=0 then
         begin
              case pos of
              59..68:    t:='F'+cisl[pos-58];
              84..93:    t:='Shift F'+cisl[pos-83];
              94..103:   t:='Ctrl F'+cisl[pos-93];
              104..113:  t:='Alt F'+cisl[pos-103];
              120..128:  t:='Alt '+chr(pos-71);
              else
                  t:='Alt '+polohakl[pos-15];
              end;
         end
         else if (pos<51)and(asc<32) then t:='Ctrl '+polohakl[pos-15];
         for i:=1 to pklav do if kl=tklavc[i] then t:=tklavk[i];
         nazovkl:=t;
end;



function asciisum(t:string):word; assembler;
     asm
        les     di,t
        xor     ax,ax
        xor     ch,ch
        mov     cl,es:[di]
        cmp     cx,0
        jz      @konpr
        xor     dx,dx
        inc     di
@1:     mov     dl,es:[di]
        add     ax,dx
        inc     di
        loop    @1
@konpr:
end;

function strl(cis:longint; pocm:byte):string;
var
   s:String;
begin
     str(cis:pocm,s);
     strl:=s;
end;

function strr(cis:real;pocm,des:byte):string;
var
   s:String;
begin
     str(cis:pocm:des,s);
     strr:=s;
end;

function nahrad(t,t1,t2:string):string;
var
   pol:byte;
begin
     pol:=pos(t1,t);
     while pol>0 do begin delete(t,pol,length(t1)); insert(t2,t,pol); pol:=pos(t1,t); end;
     nahrad:=t;
end;


function hexstr(cis:longint;rozsah:byte):string;

var
   k:string;
   i,j:byte;

begin
     k:='';
     for i:=rozsah downto 1 do
     begin
          j:=0;
          while cis>=vahy[i] do begin cis:=cis-vahy[i];inc(j);end;
          k:=k+hexh[j];
     end;
     hexstr:=k;
end;


function repchar(t1:string;kolko:byte):string;
var
   i:byte;
   t2:string;
begin
     t2:='';
     asm
        mov     ch,0
        mov     cl,kolko
        cmp     cx,0
        jz      @2
        push    ds
        mov     ax,ss
        mov     es,ax
        mov     ds,ax
        lea     si,t1
        lea     di,t2
        mov     dh,0
        mov     dl,[si]
        mov     al,[si]
        mov     ah,0
        mul     cl
        mov     [di],al
        inc     di
        inc     si
  @1:
        push    cx
        push    si
        mov     cx,dx
        rep  movsb
        pop     si
        pop     cx
        loopnz  @1
        pop     ds
  @2:
  end;
  repchar:=t2;
end;

function posodzadu(znak:char; t1:string):byte;
begin
     asm
        std
        push    ds
        mov     ax,ss
        mov     es,ax
        mov     al,znak
        lea     di,t1
        mov     ch,0
        mov     cl,es:[di]
        add     di,cx
        repne   scasb
        jne     @notfound
        inc     cl
        mov     @result,cl
        jmp     @kon
@notfound:
        mov     @result,0
@kon:
     end;
end;

function left(t:string;kolko:byte):string;
begin
     left:=copy(t,1,kolko);
end;

function right(t:string;kolko:byte):string;
begin
     right:=copy(t,length(t)-kolko+1,kolko);
end;


function dopznlft(t1:string;t2:char;kolko:byte):string;
begin
     if length(t1)>kolko then dopznlft:=right(t1,kolko)
     else
         dopznlft:=repchar(t2,kolko-length(t1))+t1;
end;


function dopznri(t1:string;t2:char;kolko:byte):string;
begin
     if length(t1)>kolko then dopznri:=left(t1,kolko)
     else
         dopznri:=t1+repchar(t2,kolko-length(t1));
end;


function dopznlftdl(t1:string;t2:char;kolko:byte):string;
begin
     dopznlftdl:=repchar(t2,kolko-length(t1))+t1;
end;


function dopznridl(t1:string;t2:char;kolko:byte):string;
begin
     dopznridl:=t1+repchar(t2,kolko-length(t1));
end;

function posit(subst,stri:string;od:byte):byte;
var
   k:string;
   c:byte;
begin
     if length(stri)<od then posit:=0
     else begin
               k:=right(stri,length(stri)-od+1);
               c:=pos(subst,k);
               if c>0 then posit:=c+od-1 else posit:=0;
          end;
end;



function value(c:string):longint;
var
   i:integer;
   c1:longint;
begin
   val(c,c1,i);
   if i>0 then c1:=0;
   value:=c1;
end;


function stri(c1:longint):string;
var
   t1:string;
begin
     str(c1,t1);
     stri:=t1;
end;

function upstring(t:string):string;
var
   i:byte;
begin
     for i:=1 to length(t) do begin if jediakr then if ord(t[i]) in [148..167] then t[i]:=chr(ord(t[i])-20);
         t[i]:=upcase(t[i]); end;
     upstring:=t;
end;


function downstring(t:string):string;
var
   i:byte;
begin
     for i:=1 to length(t) do begin if jediakr then if ord(t[i]) in [128..147] then t[i]:=chr(ord(t[i])+20);
         if t[i] in ['A'..'Z'] then t[i]:=chr(ord(t[i])+32); end;
     downstring:=t;
end;

function bezdiakr(t:string):string;
var
   i,j,zn:byte;
   male:boolean;
begin
     for i:=1 to length(t) do begin zn:=ord(t[i]); male:=false;
         if t[i] in ['”'..'§'] then begin dec(zn,20); male:=true; end;
         if zn in [128..147] then begin j:=0; while (j<20)and(dzn[j,1]<>zn) do inc(j);
            t[i]:=chr(dzn[j,2]); if male then t[i]:=chr(ord(t[i])+32); end; end;
     bezdiakr:=t;
end;


function lefttrim(t:string):string;
begin
     while left(t,1)=' ' do t:=copy(t,2,length(t)-1);
     lefttrim:=t;
end;

function righttrim(t:string):string;
begin
     while right(t,1)=' ' do t:=copy(t,1,length(t)-1);
     righttrim:=t;
end;

function alltrim(t:string):string;
var
   k:string;
begin
     alltrim:=lefttrim(righttrim(t));
end;


function center(str:string;dlzka:byte):string;
var
   pol:byte;
   text:string;
begin
     pol:=dlzka-length(str);
     text:=repchar(' ',pol);
     insert(str,text,pol div 2+1);
     center:=text;
end;

function poscis(t:string):string;
var
   i:byte;
begin
      i:=length(t);
     poscis:=dopznri(alltrim(t),' ',i);
end;

function preptext(t,nov:string; odp:byte):string;
begin
     delete(t,odp,length(nov));
     insert(nov,t,odp);
     preptext:=t;
end;

function aktcas(typ:byte; oddel:char):string;
var
   h,m,s,st:word;
   t:string;

begin
     gettime(h,m,s,st);
     if typ=0 then aktcas:='  '+oddel+'  '
     else begin
          t:=strl(h,2)+oddel+strl(m,2);
          if typ in [2,3,5,6] then t:=t+oddel+strl(s,2);
          if typ in [3,6] then t:=t+oddel+strl(st,2);
          if typ>3 then t:=nahrad(t,' ','0');
     end;
     aktcas:=t;
end;


end.