Версия для печати темы

program lab_Zapisi;
uses crt;
const n=9;
type stud=record
  fio:string;
  srb:integer;
  age:integer;
  pol:char;
  end;
var f1:file of stud;
m,k,a:stud;
gruppa:array[1..n] of stud;
vid: byte;
flag: boolean;
i:integer;
name:string;

procedure file_name;{ima fila}
begin
write(' Vvedite ima fila ');
readln(name);
end;

procedure zapici; {sozdanie zapici}
begin
writeln(' zapici gryppi ',filepos(f1)+1);
with gruppa[i] do
  begin
   write(' Enter FIO ');  readln(fio);
  write(' Vozrast ');  readln(age);
  write(' Pol ');  readln(pol);
  write(' CPEDHUU BALL ');  readln(srb);
  write(f1,gruppa[i]);
  end;
end;

procedure dobavit_zapic;
var
i,p:integer;
begin
file_name;
assign(f1, name);
rewrite(f1);
writeln(' Sozdanie novoy zapisi ',name);
write(' Vvedite colichestvo zapisey ');
readln(p);
for i:=1 to p do
zapici;
writeln(' Dobavlenie novogo file ');
writeln(' File imeet ',filesize(f1),' zapicei ');
close(f1);
end;

procedure vivod;
begin
read(f1,gruppa[i]);
with gruppa[i] do
begin
  write(filepos(f1));
  writeln(' FIO ',fio,' Bo3PaCT ',age,' CPEDHUU BALL ', srb,' Pol ',pol);
  end;
end;

procedure vivod_zapicei;
begin
  file_name;
  assign(f1, name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   seek(f1, 0);
   writeln(' Vivod zapicei ',name);
   while (not Eof(f1)) do
   vivod;
  close(f1);
end
  else
  writeln(' File s imenem ',name,' NET');
end;

procedure updaterec;
var
numrec: longint;
  begin
  file_name;
  assign(f1, name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   write('N zapici');
   readln(numrec);
   seek(f1,numrec-1);
   writeln(' Staroe znachenie ');
   vivod;
   seek(f1,numrec-1);
   writeln(' Zadaem novoe znachenie ',numrec,' zapici ');
   zapici;
  close(f1);
end
else
  writeln('Faila s imenem ',name,' NET ');
end;

procedure zapic_end;
begin
file_name;
assign(f1, name);
{$I-}
reset(f1);
{$I+}
if IOresult = 0 then
begin
seek(f1, filesize(f1));
zapici;
writeln('Otkritiy file imeet ',filesize(f1),' zapisey ');
close(f1);
end
else
  writeln(' File s imenem ',name,' NET ');
end;

procedure findfio;
var
f: file of stud;
gruppa: stud;
maska: string;
flag: boolean;
countrec: integer;
  begin
  file_name;
  assign(f, name);
  {$I-}
  reset(f);
  {$I+}
  if IOresult = 0 then
   begin
   write('vvedite familiy dly poiska: ');
   readln(maska);
   flag:=false;
   countrec:=0;
   while (not Eof(f)) do
    begin
    read(f,gruppa);
    with gruppa do
    if pos(maska,fio) <> 0 then
      begin
      flag:=true;
      inc(countrec);
      writeln(' FIO ',fio,' Vozrast ',age,' sped ball ', srb,' Pol ',pol);
     end;
  end;
if flag then
  begin
  writeln(' Chislo zapisey s imenem ',maska,'=',countrec);
end
else
writeln(' File ne sodershit familii ',maska);
close(f);
end
else
writeln(' Fila s imenem ',name,' NET ');
end;

procedure sort_age;
var i:integer;
f1:file of stud;
k,m:stud;
flag:boolean;
  begin
  file_name;
  assign(f1,name);
  {$I-}
  reset(f1);
  {$I+}
  if IOresult = 0 then
   begin
   for i:=1 to filesize(f1) do begin
   seek(f1,i);
   read(f1,m);
   seek(f1,i+1);
   read(f1,k);
    repeat
    if m.age >k.age then begin
    a.age:=m.age;
    m.age:=k.age;
    k.age:=a.age;
    if i>1 then dec(i);
   end
  else inc(i);
   until i>=filesize(f1);
   for i:=1 to filesize(f1) do begin
   with gruppa[i] do
   write(' FIO ',fio,' Vozrast ',age,' srednii ball',srb ,' Pol ',pol);
  end;
end;
  close(f1);
  end
  else writeln(' Fila s imenem ',name,' NET ');
end;

Begin
textcolor(6);
flag:=false;
repeat

writeln(' 1. New file');
writeln(' 2. Prosmotr gruppi ');
writeln(' 3. Izmenenie zapisi');
writeln(' 4. Dobavlenie zapici');
writeln(' 5. Poik zapisi');
writeln(' 6. Sortirovka po Bo3PACTY');
writeln(' 0. Exit');
readln(vid);
case vid of
1: dobavit_zapic;
2: begin
   clrscr;

    vivod_zapicei;
   end;
3: updaterec;
4: zapic_end;
5: findfio;
6: begin
   sort_age;
   vivod;
   end;
0: flag:=true;
end;
writeln('Nagmite enter');
readln;
clrscr;
until flag;
END.