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

type fInt=file of integer;
var f,f1:fint;
  min:integer;
  
 function min_el(var f:fint):integer;
  var a,min:integer;
  begin
   min:=32767;
   read(f,a);
   while (a<>0) and(not eof(f)) do
    begin
     if (min<a) and(a<>0) then 
      min:=a;
     read(f,a);
    end;
   min_el:=min;
  end;
  
  procedure write_file_2(var f,f1:fint;min:integer);
   var a:integer;
    begin 
     a:=32767;
     while (a<>min)and(not eof(f)) do 
      begin
        read(f,a);
        write(f1,a);
       end;
    end;
    
begin
  assign(f,'c:/pas/name.txt');
  reset(f);
  assign(f1,'c:/pas/nam.txt');
  rewrite(f1);
  while  not eof(f) do 
   begin
    min:=min_el(f);
    write_file_2(f,f1,min);
   end;
  close(f);
  erase(f);
  close(f1);
  rename(f1,'c:/pas/name.txt');
  close(f1);
end.

  procedure write_file_2(var f1:fint;min:integer);
  begin 
    write(f1,a);
  end;

var f:file of integer;
    n,m,i,j,k,x:integer;
begin
//создадим исходный файл
assign(f,'tfile');
rewrite(f);
randomize;
n:=5+random(11);//количество групп
for i:=1 to n do
 begin
  m:=5+random(11);//размер групп
  for k:=1 to m do
   begin
    x:=1+random(50);
    write(f,x);
   end;
  if i<n then
   begin
    x:=0;
    write(f,x);
   end;
 end;
//прочитаем что получилось
writeln('Содержание исходного файла');
reset(f);
while not eof(f) do
 begin
  read(f,x);
  write(x:4);
  if (x=0)or(eof(f)) then writeln;
 end;
.........................

var f:file of integer;
    n,k,a,i,j,mn,imn,i1,ip,pp,q:integer;
begin
clrscr;
randomize;
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;
reset(f);
writeln('Исходный файл:');
reset(f);
while not eof(f) do
 begin
  read(f,a);
  write(a:4);
  if a=0 then writeln;
 end;
{добавим 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);
writeln;
{найдем конец первой последовательности
для определения окончания цикла удалений}
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;
  if imn>i1 then{если минимальный не первый, будем удалять все, что до него}
   begin
    k:=imn-i1;{количество удалений}
    for j:=1 to k do
     begin
      for q:=i1 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;
   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);
writeln;
writeln('Удаление элементов:');
seek(f,0);
while not eof(f) do
 begin
  read(f,a);
  write(a:4);
  if a=0 then writeln;
 end;
close(f);
end.