BD

program baza;
uses Crt;
const
nazwa='H:\pliki\baza1.dat';
max=100;
type

  uczen=record
             imie:string[20];
             nazwisko:string[30];
             wiek:byte;
             sr_ocen:real;
       end;

  plik=file of uczen;
  tablica=array [1..max] of uczen;
var
    p:plik;
    odp:char;
    n:byte;
    ucz:uczen;
    t:tablica;

procedure do_tablicy(var t:tablica; var p:plik; var n:byte);
var i:byte;
begin
     i:=0;
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     if IOResult=0 then
        begin
                n:=filesize(p);
                for i:=1 to n do read(p,t[i]);
        end;
     close(p);
end;
procedure dopis (var p:plik);
var a:integer;
    t:tablica;
begin
     assign(p,nazwa);
     {$I-}
     reset(p);
     {$I+}
     if IOResult=0 then seek(p,filesize(p)) else rewrite(p);
     writeln('TWORZENIE NOWEGO WPISU');
     write('Podaj imie: ');
     readln(ucz.imie);
     write('Podaj nazwisko: ');
     readln(ucz.nazwisko);
     write('Podaj wiek: ');
     readln(ucz.wiek);
     write('Podaj srednia ocen: ');
     readln(ucz.sr_ocen);
     write(p,ucz);
     close(p);
     do_tablicy(t,p,n);
end;
procedure do_pliku (var t:tablica; var p:plik; n:byte);
var i:byte;
begin
     assign(p,nazwa);
     rewrite(p);
     for i:=1 to n do write(p,t[i]);
     close(p);
end;

procedure wypis (var t:tablica; n:byte);
var i:byte;
begin
     do_tablicy(t,p,n);
     for i:=1 to n do
                 begin
                      writeln(t[i].imie:20,t[i].nazwisko:20,'  wiek: ',t[i].wiek:2,'  Srednia ocen: ',t[i].sr_ocen:2:2);
                      writeln;
                 end;
      readkey;
end;

function index (var t:tablica; n:byte):byte;
var i:byte;
    nzw:string[20];
begin
        index:=0;
        write('Podaj nazwisko: ');
        readln(nzw);
        for i:=1 to n do
        if nzw=t[i].nazwisko then
        begin
        index:=i;
        break;
        end;
end;

procedure szuk (var t:tablica; n:byte);
var k,i:byte;
begin

        k:=index(t,n);
        if k<>0 then writeln(t[k].imie:20,t[k].nazwisko:20,t[k].wiek:5,' ',t[k].sr_ocen:2:2)
        else writeln('Nie ma osoby o podanym nazwisku');
        readkey;
end;

procedure usun (var t:tablica; var p:plik; var n:byte);
var i,j,k,w:byte;

begin
        assign(p,nazwa);
        rewrite(p);
        k:=index(t,n);
        if k<>0 then
        begin
                for i:=1 to k-1 do write(p,t[i]);
                for j:=k+1 to n do write(p,t[j]);

        end else
                begin
                writeln('Nie istnieje taka osoba');
                readkey;
                end;
        n:=filesize(p);
        close(p);
        do_tablicy(t,p,n);

end;

procedure menu;
var odp:char;
begin
	ClrScr;
        textcolor(green);
        writeln(' *===========================================*');
        writeln('|| 1 - Dopisywanie osoby                     ||');
        writeln('|| 2 - Wypisanie listy  osob                 ||');
        writeln('|| 3 - Wyszukiwarka                          ||');
        writeln('|| 4 - Usun                                  ||');
        writeln('|| Esc - Wyjscie                             ||');
        writeln(' *===========================================*');
        textcolor(red);
        writeln;
        writeln('Czego pragniesz?');
        textcolor(7);
	odp:=readkey;
        case odp of
        '1':dopis(p);
        '2':wypis(t,n);
        '3':szuk(t,n);
        '4':usun(t,p,n);
        #27:begin
                do_pliku(t,p,n);
                halt;
            end;
        end;

end;


begin
        do_tablicy(t,p,n);
        repeat menu;
	until false;
end.