Преобразовать файл, сохранив в каждой последовательности члены, предшествующие первому минимальному значению - PascalABC.NET

type tfile=file of integer;
procedure create_file(var f:tfile);
var n,i,j,k,a:integer;
begin
assign(f,'1111');
rewrite(f);
write('Сколько последовательностей записать в файл n=');
readln(n);
for i:=1 to n do
 begin
  k:=5+random(6);//длина последовательности от 5 до 10
  for j:=1 to k do
   begin
    a:=random(20)+1;
    write(f,a);
   end;
  if i<>n then
   begin
    a:=0;
    write(f,a);
   end;
 end;
close(f);
end;
procedure read_file(var f:tfile;s:string);
var a:integer;
begin
writeln(s);
reset(f);
while not eof(f) do
 begin
  read(f,a);
  write(a:4);
  if a=0 then writeln;
 end;
close(f);
writeln;
end;
procedure udal(var f:tfile);
var i,a,pp,ip,i1,j,mn,imn,k,q:integer;
begin
reset(f);
//добавим 0 в начало файла для удобства
for i:=filesize(f)downto 1 do
 begin
  seek(f,i-1);
  read(f,a);
  seek(f,i);
  write(f,a);
 end;
a:=0;
seek(f,0);
write(f,a);
//найдем конец первой последовательност
//для определения окончания цикла удалений}
i:=1;
pp:=0;
while(i<filesize(f))and(pp=0) do
 begin
  seek(f,i);
  read(f,a);
  if a=0 then pp:=i-1
  else i:=i+1;
 end;
ip:=filesize(f)-1;//конец последней последовательности
//начнем с конца файла, чтобы не сбивались индексы после удаления
while ip>=pp do//пока не перешагнули через конец первой последовательности
 begin
  i1:=-1;//начало последовательности, пока не знаем, будем искать
  j:=ip;
  while(j>=0)and(i1=-1) do
   begin
    seek(f,j);
    read(f,a);
    if a=0 then i1:=j+1//если нашли 0, то за ним начало
    else j:=j-1;
   end;
  seek(f,i1);
  read(f,mn);
  imn:=i1; //будем искать позицию первого мин. в этой последовательности
  for j:=i1 to ip do
   begin
    seek(f,j);
    read(f,a);
    if a<mn then
     begin
      mn:=a;
      imn:=j;
     end;
   end;
  k:=ip-imn+1;//количество удалений
  for j:=1 to k do
   begin
    for q:=imn to filesize(f)-2 do//сдвигаем на 1 вверх нижние элементы
     begin
      seek(f,q+1);
      read(f,a);
      seek(f,q);
      write(f,a);
     end;
    seek(f,filesize(f)-1);//удаляем последний
    truncate(f);
   end;
  ip:=i1-2;//конец новой последовательности на 2 выше начала предыдущей
 end;
//удалим первый 0
for i:=0 to filesize(f)-2 do
 begin
  seek(f,i+1);
  read(f,a);
  seek(f,i);
  write(f,a);
 end;
seek(f,filesize(f)-1);
truncate(f);
end;
var f:tfile;
begin
randomize;
create_file(f);
read_file(f,'Исходный файл');
udal(f);
read_file(f,'Сохранение до минимальных в сериях');
end.