Obarvený kód souboru adresar.pas

const data    = 'adresar.dat';
      pomocny = 'adresar.bak';
type polozka = record
                titul           : string[5];
                jmeno, prijmeni : string[20];
                adresa          : string[30];
                cp              : string[5];
                psc             : string[5];
                email           : string[30];
                url             : string[30];
                tel,mobil       : string[20];
                rezervovano     : array[0..127] of byte;
               end;
var aktualni : polozka;
    menu     : byte;
    key      : char;
    zbytek   : integer;
procedure nova;
var k     : char;
    f1,f2 : file;
    pol   : polozka;
    kontr : integer;
 begin
   write('Titul:');
    readln(aktualni.titul);
   write('Jmeno:');
    readln(aktualni.jmeno);
   write('Prijmeni:');
    readln(aktualni.prijmeni);
   write('Adresa:');
    readln(aktualni.adresa);
   write('CP.:');
    readln(aktualni.cp);
   write('PSC:');
    readln(aktualni.psc);
   write('E-mail:');
    readln(aktualni.email);
   write('URL:');
    readln(aktualni.url);
   write('Telefon:');
    readln(aktualni.tel);
   write('Mobil:');
    readln(aktualni.mobil);
   write('Ulo§it?');
   repeat
    k:=readkey;
   until upcase(k) in ['A','N'];
   if upcase(k)='A' then
    begin
     assign(f1, data);
     assign(f2, pomocny);
      reset(f1,1);
      rewrite(f2,1);
       repeat
        blockread(f1,pol,sizeof(pol),kontr);
        blockwrite(f2,pol,sizeof(pol));
       until eof(f1);
      blockwrite(f2,aktualni,sizeof(aktualni));
      close(f1);
      close(f2);
      reset(f2,1);
      rewrite(f1,1);
       repeat
        blockread(f2,pol,sizeof(pol));
        blockwrite(f1,pol,sizeof(pol));
       until eof(f2);
      close(f1);
      close(f2);
    end;
 end;
procedure vypis;
 begin
   writeln('Titul:',aktualni.titul);
   writeln('Jmeno:',aktualni.jmeno);
   writeln('Prijmeni:',aktualni.prijmeni);
   writeln('Adresa:',aktualni.adresa);
   writeln('CP.:',aktualni.cp);
   writeln('PSC:',aktualni.psc);
   writeln('E-mail:',aktualni.email);
   writeln('URL:',aktualni.url);
   writeln('Telefon:',aktualni.tel);
   writeln('Mobil:',aktualni.mobil);
 end;
procedure prehled;
var poz,max : integer;
    f       : file;
 begin       (*8-72  2-80*)
  assign(f,data);
   reset(f,1);
   poz:=1;
   max:=filesize(f) div sizeof(aktualni);
   dec(max);
    if max>0 then
     begin
      repeat
       seek(f,sizeof(aktualni)*poz);
       blockread(f,aktualni,sizeof(aktualni));
        vypis;
       key:=readkey;
       case key of
        #72 : begin
               dec(poz);
              end;
        #80 : begin
               inc(poz);
              end;
       end;
       if poz<1 then poz:=max;
       if poz>max then poz:=1;
      until key=#27;
     end;
  close(f);
 end;
procedure vymazat;
var poz,max,pre : integer;
    f,f1,f2     : file;
    kontr       : integer;
 begin
  assign(f,data);
   reset(f,1);
   poz:=1;
   max:=filesize(f) div sizeof(aktualni);
   dec(max);
    if max>0 then
     begin
      repeat
       seek(f,sizeof(aktualni)*poz);
       blockread(f,aktualni,sizeof(aktualni));
        vypis;
       key:=readkey;
       case key of
        #72 : begin
               dec(poz);
              end;
        #80 : begin
               inc(poz);
              end;
        #13 : begin
               close(f);
               assign(f1, data);
               assign(f2, pomocny);
                reset(f1,1);
                rewrite(f2,1);
                 for pre:=0 to poz-1 do
                  begin
                   seek(f1,sizeof(aktualni)*pre);
                   blockread(f1,aktualni,sizeof(aktualni));
                   blockwrite(f2,aktualni,sizeof(aktualni));
                  end;
                 for pre:=poz+1 to max do
                  begin
                   seek(f1,sizeof(aktualni)*pre);
                   blockread(f1,aktualni,sizeof(aktualni));
                   blockwrite(f2,aktualni,sizeof(aktualni));
                  end;
               close(f1);
               close(f2);
               reset(f2,1);
               rewrite(f1,1);
                repeat
                 blockread(f2,aktualni,sizeof(aktualni),kontr);
                 blockwrite(f1,aktualni,sizeof(aktualni));
                until eof(f2);
               close(f1);
               close(f2);
              end;
       end;
       if poz<1 then poz:=max;
       if poz>max then poz:=1;
      until (key=#27) or (key=#13);
     end;
 end;
procedure init;
 begin
  writeln('1 - Novou polozku');
  writeln('2 - Nahled do seznamu');
  writeln('3 - Vymazat');
  writeln;
  writeln('0 - Konec');
 end;
begin
 menu:=9;
 init;
  repeat
   key:=readkey;
   val(key,menu,zbytek);
   case menu of
    1 : begin
         nova;
         init;
        end;
    2 : begin
         prehled;
         init;
        end;
    3 : begin
         vymazat;
         init;
        end;
   end;
  until menu=0;
end.

created by PaJa