Umiestnenie súboru www.TrSek.com/cover/patak/adresar.pas{ ADRESAR.PAS Copyright (c) Pavel Patak }
{ Program vytvori oboustranne zretezeny seznam kontaktu, }
{ je to jen ukazka, chybi vyhledavani, import/export kontaktu, }
{ v abeceda rozhoduji velka/mala pismena... Nejsou osetreny pripady }
{ blbeho uzivatele - zadani neexistujiciho jmena souboru, }
{ ulozeni prazdneho adresare ... }
{ }
{ Datum:28.10.2004 http://www.trsek.com }
program Adresar;
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 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 : file of TData;
begin
Write('Nacist ze souboru (udavejte bez pripony) : ');
Readln(JmenoSouboru);
JmenoSouboru:=JmenoSouboru+'.adr';
Assign(fData,JmenoSouboru);
Reset(fData);
repeat
New(Soucasny^.Dalsi);
Read(fData,Soucasny^.Dalsi^.Data);
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 : file of TData;
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;
Write(fData,Soucasny^.Data);
until Soucasny^.Dalsi=Hlavicka;
Close(fData); {Jinak by se ani neulozil na disk}
end;
begin
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('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;
'N': Nahraj;
'U': Uloz;
end;
until R='K';
end.