после каждого отрицательного элемента вставить нулевой элемент.

uses crt;
var f:file of real;
    a,b:real;
    n,i,j,k:integer;
begin
clrscr;
randomize;
assign(f,'file1');
rewrite(f);
write('Сколько чисел записать в файл? n=');
readln(n);
for i:=1 to n do
 begin
  repeat
   a:=9*random-4;
  until a<>0;{ноли не пишем}
  write(f,a);
 end;
reset(f);
writeln('Содержание исходного файла:');
k:=0;
while not eof(f) do
 begin
  read(f,a);
  write(a:0:1,' ');
  if a<0 then k:=1;{фиксируем наличие отрицательных}
 end;
writeln;
close(f);
if k=0 then{если нет отрицательных}
 begin
  write('В файле нет отрицательных чисел!');
  readln;
  exit;{выходим из программы}
 end;
reset(f);{если есть отрицательные, продолжаем}
b:=0;
for i:=filesize(f)-2 downto 0 do{идем с предпоследнего числа вверх по файлу}
 begin
  seek(f,i);
  read(f,a);{читаем компоненты}
  if a<0 then{если отрицательная}
   begin
    for j:=filesize(f) downto i+2 do{сдвигаем на 1 вниз все компоненты,
 начиная с компоненты за отрицательным}
     begin
      seek(f,j-1);
      read(f,a);
      seek(f,j);
      write(f,a);
     end;
    seek(f,i+1);{встаем за отрицательным}
    write(f,b);{пишем ноль}
   end;
 end;
seek(f,filesize(f)-1);{проверяем последнюю компоненту}
read(f,a);
if a<0 then{если отрицательная}
 begin
  seek(f,filesize(f));{встаем за ней}
  write(f,b);{пишем ноль}
 end;
close(f);
reset(f);
writeln('Содержание исходного файла:');
k:=0;
while not eof(f) do
 begin
  read(f,a);
  write(a:0:1,' ');
  if a<0 then k:=1;
 end;
close(f);
readln
end.