PROGRAM Seriova_linka;

USES
  Crt, ibmcom;		{ibmcom je ke stazeni na www.programmersheaven.com}

{Po spusteni program nacita znak ze serioveho portu COM1, po nacteni 12 znaku
ziskane cislo zkusi najit v textovem souboru seznam.txt v aktualnim adresari.
Pokud toto cislo najde, zjisti jmeno majitele TM a jeho pristupove pravo,
oboji zobrazi na obrazovce. Pokud ma dana osoba vyssi pristupove pravo (1),
program mu povoli dalsi operaci - v nasem pripade soucet dvou cisel. Pokud
ma dana osoba nizsi pristupove pravo (ruzne od 1),program mu dalsi operaci
nepovoli a zacne se testovat dalsi TM.}

PROCEDURE read_key (VAR ch1, ch2: Char);
BEGIN
  ch1 := ReadKey;
  IF ch1 = #0 THEN
    ch2 := ReadKey
  ELSE
    ch2 := #0;
END;

type clovek=record
            jmeno    : string[40];
            cislo    : string[12];
            prava    : string[1];
          end;

CONST
  port = 1;                     {zarizeni musi byt pripojeno na portu COM1}
  initial_speed = 19200;        {komunikacni rychlost 19200b/s}


VAR
  lidi     : array [1..1000] of Clovek;      {max.1000 lidi v seznamu}
  puvodni:string[40];
  result   : Word;
  exit_prog: Boolean;
  ch1, ch2 : Char;
  ch,ch3      : Char;
  volba    : integer;
  sercislo : string[12];
  pocetlidi: Integer;
  n:integer;

procedure Nacti;
var soubor   : text;
begin
  assign (soubor,'seznam.txt');
  reset (soubor);
  pocetlidi:=0;
  while not eof(soubor) do
  begin
    pocetlidi:=pocetlidi+1;
    readln (soubor,lidi[pocetlidi].jmeno);
    readln (soubor,lidi[pocetlidi].cislo);
    readln (soubor,lidi[pocetlidi].prava);
  end;
  close (soubor);
end;

procedure soucet;
var a,b:integer;
begin
  gotoxy (10,12);
  write ('Pristup povolen  ');
  gotoxy (10,15);
  write ('Zadej cislo a:');
  readln (a);
  gotoxy (10,16);
  write ('Zadej cislo b:');
  readln (b);
  gotoxy (10,17);
  write (a,'+',b,'=',a+b);
end;

procedure zobraz (cis:integer);
begin
  gotoxy (10,10);
  write ('                                                 ');
  gotoxy (10,9);
  write('Jmeno uzivatele');
  gotoxy(32,9);
  write('Pristupove pravo');
  gotoxy (10,10);
  write (lidi[cis].jmeno);
  gotoxy(32,10);
  write(lidi[cis].prava);
  if lidi[cis].jmeno<>puvodni then
  begin
    puvodni:=lidi[cis].jmeno;
    if lidi[cis].prava='1' then
    soucet
    else
    begin
    gotoxy (10,12);
    write ('Pristup nepovolen');
    gotoxy (10,15);
    write ('                ');
    gotoxy (10,16);
    write ('                ');
    gotoxy (10,17);
    write ('                ');
    end;
  end;
end;

procedure kontrola;
var n:integer;
begin
  n:=1;
  while (sercislo<>lidi[n].cislo) and (n<=pocetlidi) do
  n:=n+1;
  if n<=pocetlidi then
  zobraz(n)
  else
  begin
    gotoxy (10,9);
    write('Jmeno uzivatele');
    gotoxy(32,9);
    write('Pristupove pravo');
    gotoxy (10,10);
    write ('Nenalezeno v databazi                  ');
  end;
end;


BEGIN
clrscr;
Writeln('Zabezpeceni pristupu do programu');
Writeln('=============================================================================');
Writeln('Rezim prijimani');
write('Port: COM',port);
writeln('  Rychlost: ',initial_speed,'b/s');
writeln('Stiskem Alt-X ukoncite program');


  ComInstall (port, result);
  IF result <> 0 THEN
    BEGIN
    CASE result OF
      1: Writeln ('Chybne cislo portu: ', port);
      2: Writeln ('UART port nenalezen: ', port);
      3: Writeln ('Driver je uz jednou instalovan');
    ELSE
      Writeln ('Neocekavana chyba v ComInstall', result);
      END;
    Exit;
    END;
  ComRaiseDTR;                 {nastavi DTR}
  ComSetSpeed (initial_speed); {nastavi komunik.rychlost}
  ComSetParity (ComNone, 1);   {zadna parita,8 datovych bitu,1 stop bit}
  exit_prog := False;
  nacti;
  REPEAT
    IF KeyPressed THEN
    BEGIN
      read_key (ch1, ch2);
      CASE ch2 OF
          #45: {Alt-X}
          exit_prog := True;
      END;
    END;
    ch3 := ComRx;              {nacteni 1 znaku}
    IF ch3 <> #0 THEN
    begin
      sercislo:=sercislo+ch3;          {po 12 znacich kontrola cisla}
      if length(sercislo)=12 then
      begin
        kontrola;
        sercislo:='';
      end;
    end;

  UNTIL exit_prog;
END.