написал, но пишет ошибку при попытке отсортировать, не могу устранить. помогите пожалуйста
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.