DataShredder

program DataShredder;
uses crt;
type
  zaznam = record jmeno, prijmeni:string; vek:real; end;
var
ukonceni:boolean;
prikaz:string;
data: file of zaznam;

function overeni(jmeno:string):boolean;
var
   pf : file;
begin
{$I-}
   Assign(pf,jmeno);
   Reset(pf);
   if IOResult=0 then
   begin
      Close(pf);
      overeni:=true;
   end
   else
      overeni:=False;
{$I+}
end;

procedure nova;
var nazev:string;
begin
clrscr;
repeat
writeln('Zadejte název:');
readln(nazev);
until length(nazev) > 0;

assign(data,nazev);
if overeni(nazev) then writeln('Taková databáze již existuje.')
else begin rewrite(data); close(data); writeln('Databáze vytvořena.');end;

writeln;
end;

procedure vlozit;
var nazev:string; i,j:integer; zasobnik:zaznam;
begin
clrscr;
repeat
writeln('Do jakého souboru chcete zapisovat?');
readln(nazev);
until length(nazev) > 0;
if not overeni(nazev) then begin  writeln; writeln('Taková databáze neexistuje.'); writeln;writeln('Stiskem ENTER se vrátíte do menu.'); readln; exit; end;


writeln('Kolik položek chcete zapsat?');
readln(i);

assign(data, nazev);
reset(data);
j:=1;
for j:=1 to i do begin
with zasobnik do
   begin
      Writeln;
      Write('jmeno: ');
      Readln(jmeno);
      Write('prijmeni: ');
      Readln(prijmeni);
      Write('vek: ');
      Readln(vek);

   end;
seek(data,FileSize(data));
write(data,zasobnik);
end;

close(data);
clrscr;
writeln('Zadání dat proběhlo úspěšně.');
writeln;
end;

procedure vypsat;
var zasobnik:zaznam; nazev:string;
begin
repeat
writeln('Z jakého souboru chcete vypisovat?');
readln(nazev);
until length(nazev) > 0;
if not overeni(nazev) then begin  writeln; writeln('Taková databáze neexistuje.'); writeln;writeln('Stiskem ENTER se vrátíte do menu.'); readln; exit; end;
clrscr;
assign(data,nazev);
reset(data);

while not eof(data) do begin
read(data, zasobnik);
with zasobnik do
  begin
    writeln();
    writeln(jmeno,' ', prijmeni, ' ', vek:2:1 );

  end;

end;

close(data);

writeln;
writeln('Pro pokračování stisknete ENTER.');
readln;
clrscr;
end;

procedure smazat;
var nazev:string; ov:boolean;
begin
repeat
writeln('Zadejte název databáze, kterou chcete smazat:');
readln(nazev);
until length(nazev) > 0;
ov:=overeni(nazev);
clrscr;
if ov=true then begin assign(data,nazev); erase(data); writeln('Databáze smazána.'); end else writeln('Takova databaze neexistuje.');
writeln;
end;

procedure tridit;
var
i,j,fs:integer;
{f:file of zaznam;}
a:array[1..1000] of string;
b:array[1..1000] of string;
c:array[1..1000] of real;
q:zaznam;
p:boolean;
nazev,polozka,prvek,podle,jak:string;
begin
clrscr;
repeat
writeln('Jakou databázi chcete setřídit?');
readln(nazev);
until length(nazev) > 0;
if not overeni(nazev) then begin  writeln; writeln('Taková databáze neexistuje.'); writeln;writeln('Stiskem ENTER se vrátíte do menu.'); readln; exit; end;


assign(data,nazev);
reset(data);
fs:=filesize(data);

{Načtení do tabulky.}
i:=1;
while not EoF(data) do begin
read(data,q);
a[i]:=q.jmeno;
b[i]:=q.prijmeni;
c[i]:=q.vek;
inc(i);

end;
close(data);


writeln('Podle kterého prvku chcete třídit? (jmeno, prijmeni, vek)');
readln(prvek);
case prvek of
  'vek': begin

{Třízení - bubblesort}
repeat
p:=false;
for i:=1 to fs-1 do begin
  if (c[i]>c[i+1]) then
         begin
         p:=true;

         q.vek:=c[i]; c[i]:=c[i+1]; c[i+1]:=q.vek;
         q.jmeno:=a[i]; a[i]:=a[i+1]; a[i+1]:=q.jmeno;
         q.prijmeni:=b[i]; b[i]:=b[i+1]; b[i+1]:=q.prijmeni;
         end;

end;
until p=false;
  end;

  'jmeno': begin
{Třízení - bubblesort}
repeat
p:=false;
for i:=1 to fs-1 do begin
  if (a[i]>a[i+1]) then
         begin
         p:=true;

         q.vek:=c[i]; c[i]:=c[i+1]; c[i+1]:=q.vek;
         q.jmeno:=a[i]; a[i]:=a[i+1]; a[i+1]:=q.jmeno;
         q.prijmeni:=b[i]; b[i]:=b[i+1]; b[i+1]:=q.prijmeni;
         end;

end;
until p=false;
end;


  'prijmeni': begin
{Třízení - bubblesort}
repeat
p:=false;
for i:=1 to fs-1 do begin
  if (b[i]>b[i+1]) then
         begin
         p:=true;

         q.vek:=c[i]; c[i]:=c[i+1]; c[i+1]:=q.vek;
         q.jmeno:=a[i]; a[i]:=a[i+1]; a[i+1]:=q.jmeno;
         q.prijmeni:=b[i]; b[i]:=b[i+1]; b[i+1]:=q.prijmeni;
         end;

end;
until p=false;
end;

else begin writeln('Nezadali jste, podle čeho třídit.'); writeln; exit; end; end; {else vztahujicise k case of}

writeln('Jak třídit, sestupně nebo vzestupně? (sestupne, vzestupne)');
readln(jak);

{Zapsani do souboru}
rewrite(data);
if jak='sestupne' then begin
  for i:=1 to fs do begin
    j:=fs-i+1;
    q.jmeno:=a[j];
    q.prijmeni:=b[j];
    q.vek:=c[j];
    write(data,q);
  end;
  jak:='sestupně'
  end

else begin
  for i:=1 to fs do begin
    q.jmeno:=a[i];
    q.prijmeni:=b[i];
    q.vek:=c[i];
    write(data,q);
    end;
    jak:='vzestupně'
end;
close(data);


case prvek of
'vek': podle:='věku';
'jmeno': podle:='jména';
'prijmeni': podle:='příjmení'; end;


clrscr;
writeln('Setřízeno ',jak,' podle ',podle,'.');
writeln;

end;


procedure vyjmout;
var nazev,jmeno,prijmeni:string; i,j,fs,id:integer;
a:array[1..1000] of string;
b:array[1..1000] of string;
c:array[1..1000] of real;
q:zaznam;
begin

clrscr;
repeat
writeln('Z jake databaze chcete odstranit polozku?');
readln(nazev);
until length(nazev) > 0;
if not overeni(nazev) then begin  writeln; writeln('Taková databáze neexistuje.'); writeln;writeln('Stiskem ENTER se vrátíte do menu.'); readln; exit; end;

clrscr;
assign(data,nazev);
reset(data);

{vypis, aby bylo videt, co tam je}
while not eof(data) do begin
read(data, q);
with q do
  begin
    writeln();
    writeln(jmeno,' ', prijmeni, ' ', vek:2:1 );

  end;

end;
close(data);

writeln;
writeln('Zadejte jmeno a prijmeni z polozky, kterou chcete odstranit.');
readln(jmeno);readln(prijmeni);


{Načtení do tabulky.}
assign(data,nazev);
reset(data);
fs:=filesize(data);
i:=1;
while not EoF(data) do begin
read(data,q);
a[i]:=q.jmeno;
b[i]:=q.prijmeni;
c[i]:=q.vek;
inc(i);
end;
close(data);

{Vymazani z tabulky zaznamu, ktery se ma odstranit}

for i:=1 to fs do begin
  if a[i]=jmeno then if b[i]=prijmeni then id:=i;

end;



{Zapsani do souboru}
rewrite(data);
j:=1;
for i:=1 to fs-1 do begin
     if i=id then j:=i+2 else j:=i;

    q.jmeno:=a[j];
    q.prijmeni:=b[j];
    q.vek:=c[j];
    write(data,q);
    ;
    end;
close(data);

clrscr;
writeln('Položka odstraněna.');
writeln();

end;

procedure menu;
begin
textbackground(black);
textcolor(white);
writeln('Vyberte akci:');

textcolor(14);write('V:');textcolor(white);writeln(' vypsat databázi');
textcolor(14);write('T:');textcolor(white);writeln(' třídit databázi');
textcolor(14);write('Z:');textcolor(white);writeln(' zapsat do databáze');
textcolor(14);write('O:');textcolor(white);writeln(' odstranit položku z databáze');
textcolor(14);write('S:');textcolor(white);writeln(' smazat databázi');
textcolor(14);write('N:');textcolor(white);writeln(' nová databáze');
textcolor(14);write('E:');textcolor(white);writeln(' ukončit program');
writeln;
readln(prikaz);
case prikaz of
  'N': nova;
  'Z': vlozit;
  'S': smazat;
  'V': vypsat;
  'O': vyjmout;
  'E': ukonceni:= true;
  'T': tridit;
  'n': nova;
  'z': vlozit;
  's': smazat;
  'v': vypsat;
  't': tridit;
  'o': vyjmout;
  'e': ukonceni:= true;
else begin writeln('Zadali jste špatný příkaz'); ukonceni:= false; exit; end;
end;

end;

begin
textbackground(white);
textcolor(black);
ukonceni:=false;
writeln('Vítejte v databázovém nástroji DataShredder');
writeln;

repeat
menu;
until ukonceni=true;

end.