program promenne;
{Program vytvori dve dynamicke promenne a pak je secte}
type PInt = ^integer;
var pa,pb,pc:PInt;

begin
 {Nejprve vyhradime misto v pameti}
 pa:=new(PInt);
 pb:=new(PInt);

 {Pote do nej nacteme hodnoty}
 write('Zadej dve cela cisla: ');
 readln(pa^,pb^);

 {Vysledek secteme, ulozime do pc^ a vypisime}
 pc:=new(PInt); {Pro promennou pc^ musime nejprve vyhradit v pameti misto}
 pc^:=pa^+pb^;
 writeln(pa^, ' + ',pb^,' = ',pc^);

 {Nyni jiz promenne nepotrebujeme, a tak uvolnime zabrane misto}
 dispose(pa);
 dispose(pb);
 dispose(pc);

 {Nasleduje Readln; abychom videli vysledek programu}
 Readln;
end.    {of program promenne}

*****************************************************************************

program jednosmernyseznam;
{Program vytvori jednosmerny seznam s hlavickou,
ten pak vypise}

type    mujtyp=integer;
        PItem=^TItem;
        TItem=record
                 prvek:mujtyp;
                 next:PItem;
              end;

function vytvor_seznam:PItem;
{Vytvori hlavicku jednosmerne zretezeneho seznamu}
var a:PItem;
begin
 a:=new(PItem);
 vytvor_seznam:=a;
 a^.prvek:=0;
 a^.next:=nil;   {Data dynamicky alokovanych
                 promennych musime INICIALIZOVAT SAMI}
end;

function zadej(list:Pitem):Pitem;
{Zada data do seznamu, zadavani dat je ukonceno
zadani hodnotou nula. Samozrejme je mozne nahradit
nejakou jinou podminkou, pokud chceme, aby se v nasem
seznamu mohla objevit i nula}
var i:mujtyp;
begin
 zadej:=list;
 write('Zadejte data (seznam ukoncete zadanim hodnoty 0): ');
 read(i);
 while i<>0 do
  begin
   list^.next:=new(PItem);
   list:=list^.next;
   list^.next:=nil; {Dynamicke promenne urcite nejsou inicializovane,
                 musime to zaridit sami!!! (jinak nam muze
                 posledni prvek seznamu ukazovat uplne kamkoli)}
   list^.prvek:=i;
   read(i);     {Takhle napsane read napsat cisla na jednu radku
                a oddelit je pouze mezerami}
  end;
 readln;
end;

function vypis(list:Pitem):integer;
{Vypise seznam a vrati pocet vypsanych prvku}
{Slo by napsat i rekurzivni proceduru,
ale ta by zabirala mnoho pameti a pro vetsi seznamy
by tak byla nepouzitelna}
var i:Word;
begin
 i:=0;
 while list^.next<>nil do
  begin
   list:=list^.next;
   write(list^.prvek:5);
   i:=i+1;
  end;
 vypis:=i;
 writeln;
end;

function zrus(list:Pitem):integer;
{pri praci s dynamicky alokovanymi promennymi je UKLID NUTNY}
{tato funkce zrusi dynamicky alokovany seznam}
var pa:PItem;
    i:word;
begin
 i:=0; {Promenne ve funkcich nelze inicializovat pomoci const i:integer=0;
       tato konstrukce ma totiz jiny vyznam: promenna nezanikne po skonceni
       funkce, ale pamatuje si svou hodnotu pro dalsi volani}
 while list<>nil do
  begin
   pa:=list^.next;
   dispose(list);
   list:=pa;
   i:=i+1;
  end;
 zrus:=i;
end;

var list:Pitem;
    i:word;
begin
 list:=vytvor_seznam;
 list:=zadej(list);
 i:=vypis(list);
 writeln('Vas seznam mel celkem ',i,' prvku');
 i:=zrus(list);
 writeln('Z pameti bylo odstraneno ',i, ' prvku (vcetne hlavicky)');
 readln;
end.

******************************************************************************

program obousmerne_zretezeny;
{program ilustruje vytvoreni oboustranne zretezeneho seznamu s hlavickou}
{Vsechny seznamy budeme vytvaret s hlavickou, znamena to sice jeden prvek
navic, ale vyrazne lepe se s nimi manipuluje (veskere procedury a funkce
jsou pak kratsi, rychlejsi a zabiraji mene pameti). Je to vhodna technika
i pokud prvky zabiraji ohromne mnozstvi pameti - pak staci skutecna data
nahradit ukazateli na ne a do hlavicky dat nil.
My budeme ilustrovat jednodussi pristup, kdy data zabiraji v pameti malo
mista a vyplati se je tedy skladovat primo v seznamu}

type mujtyp=integer;
     PItem=^TItem;
     TItem=record
                 prvek:mujtyp;
                 next,prev:PItem;
           end;

function vytvor_seznam:PItem;
{Vytvorime hlavicku obousmerne zretezeneho kruhoveho seznamu s hlavickou,
tj. hlavicka ukazuje na prvni prvek a posledni prvek ukazuje na hlavicku}
var pa:PItem;
begin
 pa:=new(Pitem); {Je sice mozne psat i pouhe New(pa); osobne
                 ale preferuji druhy styl zapisu, vice se blizi C++}
 pa^.next:=pa; {Seznam je prazdny, hlavicka tedy ukazuje sama na sebe}
 pa^.prev:=pa;
 pa^.prvek:=0;
 vytvor_seznam:=pa;
end;

function zadej(list:PItem):PItem;
{Zada data do obousmerne zretezeneho kruhoveho seznamu}
var a:PItem;
    i:mujtyp;
begin
 zadej:=list;
 write('Zadejte hodnoty (zadavani ukoncite zadanim hodnoty 0): ');
 read(i);
 while i<>0 do
  begin
   a:=new(PItem);
   a^.prvek:=i;
   a^.prev:=list;
   a^.next:=list^.next;
   list^.next:=a;
   a^.next^.prev:=a;
   list:=a;
   read(i);
  end;
 readln;
end;

function vypis(list:PItem):word;
{Vypise oboustranne zretezeny kruhovy seznam a vrati pocet vypsanych prvku
(predpoklada, ze seznam je spravne zadany, jinak se zacykli)}
{Pri praci se slozitejsimi strukturami se vyplati
prvne si napsat funkce pro vypis, i kdyz je pozdeji treba
nebudeme potrebovat. K lazeni se hodi.}
var a:PItem;
    i:word;
begin
 a:=list;
 while a^.next<>list do
  begin
   a:=a^.next;
   write(a^.prvek:5);
   i:=i+1;
  end;
 vypis:=i;
end;

function zrus(list:Pitem):word;
{Zrusi cely seznam, tato funkce je hodne odlisna
od funkce, ktera pouze zrusi vybrany prvek}
{vraci pocet zrusenych prvku (vcetne hlavicky)}
var a,b:PItem;
    i:word;
begin
 a:=list;

 i:=1;
 while a^.next<>list do
  begin
   b:=a^.next;
   dispose(a);
   a:=b;
   i:=i+1;
  end;
 dispose(a); {Zrusime posledni prvek}
 zrus:=i;
end;


var list:PItem;
begin
 list:=vytvor_seznam;
 list:=zadej(list);
 write('Vas seznam: ');
 vypis(list); {Vyuzivame vyhod volnejsi syntaxe - i funkce lze volat jak procedury}
 writeln;
 write('Rusim seznam: ');
 writeln('Celkem zruseno: ',zrus(list), ' prvku (vcetne hlavicky)');
 readln;
end.

******************************************************************************

program Adresar;
{Program vytvori oboustranne zretezeny seznam kontaku,
je to jen ukazka, chybi podrobne informovani uzivatele o tom, co se prave
deje, graficky design je sileny, program neni moc uzivatelsky prijemny,
chybi vyhledavani, import/export kontaktu, v abeceda rozhoduji velka/mala
pismena... Nejsou osetreny pripady blbeho uzivatele - zadani neexistujiciho
jmena souboru, ulozeni prazdneho adresare...}

{Pro ukonceni zadavani dat zadejte prazdne jmeno}
type PSeznam = ^TSeznam;
     TData   = record
                    Jmeno : string[50];
		   Telefon: string[12];
		    Email : string[50];
		   end;
     TSeznam = record
                Data  : TData;
            Predchozi : PSeznam;
                Dalsi : PSeznam;
               end;
const UData : TData = (Jmeno:'nikdo';Telefon:'nema';Email:'zadny'); {Data hlavicky}
var Hlavicka,Soucasny : PSeznam;
    Seznam : TSeznam;
    ZData   : TData;
    r       : char;

procedure Inicializace; {Drzadlo}
begin
 New(Hlavicka);
 Hlavicka^.Dalsi:=Hlavicka;
 Hlavicka^.Predchozi:=Hlavicka;
 Hlavicka^.Data:=UData;
 Soucasny:=Hlavicka;
end;

procedure Zadej; {Vytvori kruhovy oboustranne zretezeny seznam}
begin
 repeat
 Write('Jmeno : ');
 Readln(ZData.Jmeno);
 if ZData.Jmeno <> '' then
  begin
   Write('Telefon : ');
   Readln(ZData.Telefon);
   Write('Email : ');
   Readln(ZData.Email);

   New(Soucasny^.Dalsi);
   Soucasny^.Dalsi^.Predchozi:=Soucasny;
   Soucasny:=Soucasny^.Dalsi;
   Soucasny^.Data:=ZData;
   Soucasny^.Dalsi:=Hlavicka;
   Writeln;
  end;
 until ZData.Jmeno='';
end;

procedure Vypis; {Vypise cely seznam}
var Zobrazeno : Byte; {Aby se vse veslo na obrazovku}
begin
 Zobrazeno:=0;
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 Writeln;

 repeat
 Inc(Zobrazeno);
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno);
 Writeln('Telefon :',Soucasny^.Data.Telefon:12,'    Email : ',Soucasny^.Data.Email);
 Writeln; {Pro prehlednost}
 if Zobrazeno = 7 then
  begin
   Writeln;
   Writeln('Press ENTER to continue');
   Readln;
  end;
 until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse - Press ENTER to continue');
 Readln;
end;

procedure Zmen; {Vypise vsechny prvky a zepta se na moznost zmeny}
var c:char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email:30, ' Zmenit(A/N):');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Write('Nove jmeno :');
   Readln(ZData.Jmeno);
   Write('Novy telefon :');
   Readln(ZData.Telefon);
   Write('Novy email :');
   Readln(ZData.Email);
   Soucasny^.Data:=ZData;
  end;
 until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Odstran; {Odstrani vybrane prvky ze seznamu}
var Smaz:PSeznam;
    c   :char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email:30,' Odstranit(A/N)');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Smaz:=Soucasny;
   Soucasny^.Predchozi^.Dalsi:=Soucasny^.Dalsi;
   Smaz^.Dalsi^.Predchozi:=Smaz^.Predchozi;
   Soucasny:=Smaz^.Predchozi;
   Dispose(Smaz); {Mazeme az ted!!}
  end;
  until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Pridej; {Prida novy prvke}
var Novy:PSeznam;
    c   :char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno:20,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email,' Pridat pred(A/N)');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Write('Nove jmeno : ');
   Readln(ZData.Jmeno);
   Write('telefon : ');
   Readln(ZData.telefon);
   Write('email : ');
   Readln(ZData.Email);
   New(Novy);
   Novy^.Data:=ZData;

   Novy^.Dalsi:=Soucasny;
   Novy^.Predchozi:=Soucasny^.Predchozi;
   Soucasny^.Predchozi:=Novy;
   Novy^.Predchozi^.Dalsi:=Novy; {To jsou snad cary, ale je to tak, ukazatele ted sedi}

  end;
  until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Nahraj; {Nacte oboustranne zretezeny seznam}
var JmenoSouboru : string;
    fData        : Text;
begin
 Write('Nacist ze souboru (udavejte bez pripony) : ');
 Readln(JmenoSouboru);
 JmenoSouboru:=JmenoSouboru+'.adr';
 Assign(fData,JmenoSouboru);
 Reset(fData);
 repeat
  New(Soucasny^.Dalsi);
  Readln(fData,Soucasny^.Dalsi^.Data.Jmeno);
  Readln(fData,Soucasny^.Dalsi^.Data.Telefon);
  Readln(fData,Soucasny^.Dalsi^.Data.Email);
  Readln(fData); {V souboru je prazdny radek kvuli prehlednosti}
  Soucasny^.Dalsi^.Predchozi:=Soucasny;
  Soucasny:=Soucasny^.Dalsi;
  Soucasny^.Dalsi:=Hlavicka;
 until Eof(fData);
 Close(fData);
end;

procedure Uloz; {Ulozi oboustranne zretezeny seznam}
var JmenoSouboru : string;
    fData        : Text;
begin
 Write('Ulozit do souboru (jmeno udavejte bez pripony) : ');
 Readln(JmenoSouboru);
 JmenoSouboru:=JmenoSouboru+'.adr';
 Assign(fData,JmenoSouboru);
 Rewrite(fData);
 Soucasny:=Hlavicka;
 repeat
  Soucasny:=Soucasny^.Dalsi;
  Writeln(fData,Soucasny^.Data.Jmeno);
  Writeln(fData,Soucasny^.Data.Telefon);
  Writeln(fData,Soucasny^.Data.Email);
  Writeln(fData);{Prazdny radek kvuli prehlednosti}
 until Soucasny^.Dalsi=Hlavicka;
 Close(fData); {Jinak by se soubor neulozil na disk}
end;


begin                   {A jako obvykle pri dobrem navrhu, samotne telo
                        nepotrebuje moc komentaru}
 Inicializace;
 repeat
 writeln('Co chcete delat : ');
 writeln;
 writeln('V - Vytvorit novy adresar');
 writeln('Z - Zobrazit seznam');
 writeln('O - Opravit udaje');
 writeln('S - Smazat nektera data');
 writeln('P - Pridat nove prvky');
 writeln('N - Nahrat ze souboru');
 writeln('U - Ulozit do souboru');
 writeln('K - Koncit');
 Readln(R);
 R:=UpCase(R);
 case R of
  'V': Zadej;
  'Z': Vypis;
  'O': Zmen;
  'S': Odstran;
  'P': Pridej;
  'N': Nahraj;
  'U': Uloz;
 end;
 until R='K';
end.

******************************************************************************************************************************

program Adresar;
{Totez co predtim, jen umozni vyhledavani kontaktu.
Prislusna procedura (je hned na zacatku, podivejte se na ni) vyuziva toho, ze mame oboustranne zretezeny seznam
s hlavickou}
{Pro ukonceni zadavani dat zadejte prazdne jmeno}
type PSeznam = ^TSeznam;
     TData   = record
                    Jmeno : string[50];
		   Telefon: string[12];
		    Email : string[50];
		   end;
     TSeznam = record
                Data  : TData;
            Predchozi : PSeznam;
                Dalsi : PSeznam;
               end;
const UData : TData = (Jmeno:'nikdo';Telefon:'nema';Email:'zadny'); {Data hlavicky}
var Hlavicka,Soucasny : PSeznam;
    Seznam : TSeznam;
    ZData   : TData;
    r       : char;

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure Hledej; {TADY JE ona nova procedura, poradne si ji prohlednete!}
var jmeno:string[50];
    soucasny:PSeznam;
begin
 write('Vyhledavane jmeno: ');
 readln(jmeno);
 {Abychom nemuseli stale testovat, zda jsme nahodou nedosli na konec seznamu,
 zaridime si to tak, ze hledane jmeno vzdy najdeme}
 Hlavicka^.Data.Jmeno:=Jmeno;
 soucasny:=hlavicka^.dalsi;
 while soucasny^.data.jmeno<>jmeno
  do soucasny:=soucasny^.dalsi; {prohledavame adresar, jelikoz mame zaruceno, ze neco najdeme
                    nemusime testovat, zda jsme dorazili k hlavicce,
                    ci zda nema ukazatel hodnotu nil.
                    Kdybychom tento test pridali, byl by program 2x pomalejsi}
 hlavicka^.data.jmeno:='nikdo'; {obnovime puvodni udaj}
 if soucasny=hlavicka then writeln('Nenelezeno')
  else Writeln(Soucasny^.Data.Jmeno,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email:30);
 readln;
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure Inicializace; {Drzadlo}
begin
 New(Hlavicka);
 Hlavicka^.Dalsi:=Hlavicka;
 Hlavicka^.Predchozi:=Hlavicka;
 Hlavicka^.Data:=UData;
 Soucasny:=Hlavicka;
end;

procedure Zadej; {Vytvori kruhovy oboustranne zretezeny seznam}
begin
 repeat
 Write('Jmeno : ');
 Readln(ZData.Jmeno);
 if ZData.Jmeno <> '' then
  begin
   Write('Telefon : ');
   Readln(ZData.Telefon);
   Write('Email : ');
   Readln(ZData.Email);

   New(Soucasny^.Dalsi);
   Soucasny^.Dalsi^.Predchozi:=Soucasny;
   Soucasny:=Soucasny^.Dalsi;
   Soucasny^.Data:=ZData;
   Soucasny^.Dalsi:=Hlavicka;
   Writeln;
  end;
 until ZData.Jmeno='';
end;

procedure Vypis; {Vypise cely seznam}
var Zobrazeno : Byte; {Aby se vse veslo na obrazovku}
begin
 Zobrazeno:=0;
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 Writeln;

 repeat
 Inc(Zobrazeno);
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno);
 Writeln('Telefon :',Soucasny^.Data.Telefon:12,'    Email : ',Soucasny^.Data.Email);
 Writeln; {Pro prehlednost}
 if Zobrazeno = 7 then
  begin
   Writeln;
   Writeln('Press ENTER to continue');
   Readln;
  end;
 until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse - Press ENTER to continue');
 Readln;
end;

procedure Zmen; {Vypise vsechny prvky a zepta se na moznost zmeny}
var c:char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email:30, ' Zmenit(A/N):');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Write('Nove jmeno :');
   Readln(ZData.Jmeno);
   Write('Novy telefon :');
   Readln(ZData.Telefon);
   Write('Novy email :');
   Readln(ZData.Email);
   Soucasny^.Data:=ZData;
  end;
 until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Odstran; {Odstrani vybrane prvky ze seznamu}
var Smaz:PSeznam;
    c   :char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email:30,' Odstranit(A/N)');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Smaz:=Soucasny;
   Soucasny^.Predchozi^.Dalsi:=Soucasny^.Dalsi;
   Smaz^.Dalsi^.Predchozi:=Smaz^.Predchozi;
   Soucasny:=Smaz^.Predchozi;
   Dispose(Smaz); {Mazeme az ted!!}
  end;
  until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Pridej; {Prida novy prvke}
var Novy:PSeznam;
    c   :char;
begin
 Writeln('Cely seznam :');
 Soucasny:=Hlavicka;
 repeat
 Soucasny:=Soucasny^.Dalsi;
 Writeln(Soucasny^.Data.Jmeno:20,Soucasny^.Data.Telefon:15,Soucasny^.Data.Email,' Pridat pred(A/N)');
 Readln(c);
 c:=UpCase(c);
 if C='A' then
  begin
   Write('Nove jmeno : ');
   Readln(ZData.Jmeno);
   Write('telefon : ');
   Readln(ZData.telefon);
   Write('email : ');
   Readln(ZData.Email);
   New(Novy);
   Novy^.Data:=ZData;

   Novy^.Dalsi:=Soucasny;
   Novy^.Predchozi:=Soucasny^.Predchozi;
   Soucasny^.Predchozi:=Novy;
   Novy^.Predchozi^.Dalsi:=Novy; {To jsou snad cary, ale je to tak, ukazatele ted sedi}

  end;
  until Soucasny^.Dalsi=Hlavicka;
 Writeln('To je vse');
end;

procedure Serad; {Seradi data podle abecedy}
var Zmen : LongInt; {Pocet dvojic prehozenych pri jednom pruchodu}
    Konec: Boolean;
begin
 Zmen:=0;
 Soucasny:=Hlavicka;
 repeat
 if Konec then
  begin
   Zmen:=0;
   Konec:=false;
  end;
 Konec:=Soucasny^.Dalsi=Hlavicka;
 if (Soucasny=Hlavicka) or (Soucasny^.Dalsi=Hlavicka) then {if then else lze takto pouzit}
  else
   if Soucasny^.Data.Jmeno > Soucasny^.Dalsi^.Data.Jmeno then
   Begin
    Inc(Zmen);
    Zdata:=Soucasny^.Data;
    Soucasny^.Data:=Soucasny^.Dalsi^.Data;
    Soucasny^.Dalsi^.Data:=ZData;
   End;
 Soucasny:=Soucasny^.Dalsi;
 until Konec and (Zmen=0);
end;

procedure Nahraj; {Nacte oboustranne zretezeny seznam}
var JmenoSouboru : string;
    fData        : Text;
begin
 Write('Nacist ze souboru (udavejte bez pripony) : ');
 Readln(JmenoSouboru);
 JmenoSouboru:=JmenoSouboru+'.adr';
 Assign(fData,JmenoSouboru);
 Reset(fData);
 repeat
  New(Soucasny^.Dalsi);
  Readln(fData,Soucasny^.Dalsi^.Data.Jmeno);
  Readln(fData,Soucasny^.Dalsi^.Data.Telefon);
  Readln(fData,Soucasny^.Dalsi^.Data.Email);
  Readln(fData); {V souboru je prazdny radek kvuli prehlednosti}
  Soucasny^.Dalsi^.Predchozi:=Soucasny;
  Soucasny:=Soucasny^.Dalsi;
  Soucasny^.Dalsi:=Hlavicka;
 until Eof(fData);
 Close(fData);
end;

procedure Uloz; {Ulozi oboustranne zretezeny seznam}
var JmenoSouboru : string;
    fData        : Text;
begin
 Write('Ulozit do souboru (jmeno udavejte bez pripony) : ');
 Readln(JmenoSouboru);
 JmenoSouboru:=JmenoSouboru+'.adr';
 Assign(fData,JmenoSouboru);
 Rewrite(fData);
 Soucasny:=Hlavicka;
 repeat
  Soucasny:=Soucasny^.Dalsi;
  Writeln(fData,Soucasny^.Data.Jmeno);
  Writeln(fData,Soucasny^.Data.Telefon);
  Writeln(fData,Soucasny^.Data.Email);
  Writeln(fData);{Prazdny radek kvuli prehlednosti}
 until Soucasny^.Dalsi=Hlavicka;
 Close(fData); {Jinak by se soubor neulozil na disk}
end;


begin                   {A jako obvykle pri dobrem navrhu, samotne telo
                        nepotrebuje moc komentaru}
 Inicializace;
 repeat
 writeln('Co chcete delat : ');
 writeln;
 writeln('V - Vytvorit novy adresar');
 writeln('Z - Zobrazit seznam');
 writeln('O - Opravit udaje');
 writeln('S - Smazat nektera data');
 writeln('P - Pridat nove prvky');
 writeln('E - Seradit podle abecedy');
 writeln('H - Hledej kontakt');
 writeln('N - Nahrat ze souboru');
 writeln('U - Ulozit do souboru');
 writeln('K - Koncit');
 Readln(R);
 R:=UpCase(R);
 case R of
  'V': Zadej;
  'Z': Vypis;
  'O': Zmen;
  'S': Odstran;
  'P': Pridej;
  'E': Serad;
  'H': Hledej;
  'N': Nahraj;
  'U': Uloz;
 end;
 until R='K';
end.