program ciupaga;
uses Crt;
const
nazwa2='H:\pliki\pomdart.dat';
nazwa='H:\pliki\data.dat';
max=100;
type
uczen=record
imie:string[20];
nazwisko:string[30];
wiek:byte;
sr_ocen:real;
end;
plik=file of uczen;
var
p:plik;
odp:char;
n:byte;
ucz:uczen;
procedure dopis (var p:plik);
var a:integer;
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);
end;
procedure wypis (var p:plik);
var a,i:integer;
begin
assign(p,nazwa);
{$I-}
reset(p);
{$I+}
if IOResult=0 then
begin
while not eof(p) do
begin
read(p,ucz);
writeln(ucz.nazwisko,' ',ucz.imie);
writeln(ucz.wiek,' lat');
writeln(ucz.sr_ocen:2:2,' srednia ocen');
writeln;
end;
readkey;
close(p);
end else write('Plik nie istnieje');
end;
procedure ilosc(var p:plik);
var a:string[20];
w:byte;
sr:real;
begin
assign(p,nazwa);
reset(p);
writeln('Wg jakiego kryterium wysukiwac?: ');
writeln('1 - Imie');
writeln('2 - Nazwisko');
writeln('3 - Wiek');
writeln('4 - Sr ocen');
odp:=readkey;
case odp of
'1':begin
write('Podaj poszukiwana wartosc: ');
readln(a);
writeln;
while not eof(p) do
begin
read(p,ucz);
if ucz.imie=a then begin
writeln(ucz.nazwisko,' ',ucz.imie);
writeln(ucz.wiek,' lat');
writeln(ucz.sr_ocen:2:2,' srednia ocen');
writeln;
end;
end;
end;
'2':begin
write('Podaj poszukiwana wartosc: ');
readln(a);
writeln;
while not eof(p) do
begin
read(p,ucz);
if ucz.nazwisko=a then begin
writeln(ucz.nazwisko,' ',ucz.imie);
writeln(ucz.wiek,' lat');
writeln(ucz.sr_ocen:2:2,' srednia ocen');
writeln;
end;
end;
end;
'3':begin
write('Podaj poszukiwana wartosc: ');
readln(w);
writeln;
while not eof(p) do
begin
read(p,ucz);
if ucz.wiek=w then begin
writeln(ucz.nazwisko,' ',ucz.imie);
writeln(ucz.wiek,' lat');
writeln(ucz.sr_ocen:2:2,' srednia ocen');
writeln;
end;
end;
end;
'4':begin
write('Podaj poszukiwana wartosc: ');
readln(sr);
writeln;
while not eof(p) do
begin
read(p,ucz);
if ucz.sr_ocen=sr then begin
writeln(ucz.nazwisko,' ',ucz.imie);
writeln(ucz.wiek,' lat');
writeln(ucz.sr_ocen:2:2,' srednia ocen');
writeln;
end;
end;
end;
end;
readkey;
close(p);
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 - NIE WIEM ||');
writeln('|| Esc - Wyjscie ||');
writeln(' *===========================================*');
textcolor(red);
writeln;
writeln('Czego pragniesz?');
textcolor(7);
odp:=readkey;
case odp of
'1':dopis(p);
'2':wypis(p);
'3':ilosc(p);
#27:halt;
end;
end;
begin
repeat menu;
until false;
end.