Дан файл, содержащий строки. Если третья строка не является самой длинной или самой короткой, то скопировать в новый

const n=5;
type    mas = array[1..n] of string;
var
x:mas; i,min,max: integer; f,f1:text;
procedure output (var i:integer; f,f1:text; x:mas);
  begin
    for i:=1 to n do
  readln(f, x[i]);
     for i:=1 to n do begin
  writeln(f1, x[i]);
  end;
    end;
 procedure sravn (var i:integer; var f,f1:text; x:mas);
  begin
  max:=0;
  min:=256;
  if not eof then
  for i:=1 to n do begin
      if Length(x[i])>max then Begin max:=Length(x[i]) end; end;
      for i:=1 to n do begin
      if min>Length(x[i]) then Begin min:=Length(x[i]) end; end;
      writeln(f1, min);
  writeln(f1, max);
        if (length(x[3])<=max) and (length(x[3])>=min) then 
        output(i,f,f1,x)
        else 
  writeln(f1,'Нет');
        end;
 begin
 assign(f,'f.txt');
 assign(f1,'f1.txt');
 reset(f);
 rewrite(f1);
 sravn(i,f,f1,x);
 close(f);
 close(f1);
 end.

const n=5;
var
s:string;
i,min,max: integer; f,f1:text;
 procedure sravn (var i:integer; var f,f1:text);
  procedure output (var i:integer; f,f1:text);
  begin
    while not eof(f) do begin
    for i:=1 to n do begin
  readln(f,s);
  end;
  for i:=1 to n do begin
  writeln(f1,s);
  end;
    end;
    end;
  begin
  max:=0;
  min:=256;
  while not eof(f) do begin
  readln(f, s);
      if Length(s)>max then Begin max:=Length(s) end; 
      if min>Length(s) then Begin min:=Length(s) end;
      end;
      writeln(f1, min);
      writeln(f1, max);
 
      for i:=1 to 3 do begin
      writeln(f1, length(s));
            end;
  readln(f,s);
  for i:=3 to 3 do
        if (length(s)<max) and (length(s)>min) then
     output(i,f,f1) end;
     for i:=3 to 3 do
     if (length(s)=max) or (length(s)=min) then
        writeln(f1,'Нет');
  end;
 begin
 assign(f,'f.txt');
 assign(f1,'f1.txt');
 reset(f);
 rewrite(f1);
 sravn(i,f,f1);
 close(f);
 close(f1);
 end.

var 
  f, fout : text;
  i, len, len_max, len_min, len_3 : integer;
  s, s_prev : string;
begin
  assign(f, 'text.txt');
  reset(f);
  i := 0; len_min := 255; len_max := 0;
  while not eof(f) do
  begin
    inc(i);
    readln(f, s);
    len := Length(s);
    if len > len_max then len_max := len;
    if len < len_min then len_min := len;
    if i = 3 then len_3 := len;
  end;
  if (len_3 > len_min) and (len_3 < len_max) then
  begin
    reset(f);
    assign(fout, 'text_res.txt');
    rewrite(fout);
    s_prev := '';
    while not eof(f) do 
    begin
      readln(f, s);
      if s_prev <> '' then writeln(fout, s + Copy(s_prev, 1, 3))
      else writeln(fout, s);
      writeln(s);
      s_prev := s;
    end;
    close(fout);
  end;
  close(f);
end.

procedure scan(var f : text; var len_min, len_max, len_3 : integer);
var 
  i, len : integer;
  s : string;
begin
  i := 0; len_min := 255; len_max := 0;
  while not eof(f) do
  begin
    inc(i);
    readln(f, s);
    len := Length(s);
    if len > len_max then len_max := len;
    if len < len_min then len_min := len;
    if i = 3 then len_3 := len;
  end;
end;
 
var 
  f, fout : text;
  len_max, len_min, len_3 : integer;
  s, s_prev : string;
begin
  assign(f, 'text.txt');
  reset(f);
  
  scan(f, len_min, len_max, Len_3);
  
  reset(f);
  assign(fout, 'text_res.txt');
  if (len_3 > len_min) and (len_3 < len_max) then
  begin
    rewrite(fout);
    s_prev := '';
    while not eof(f) do 
    begin
      readln(f, s);
      if s_prev <> '' then writeln(fout, s + Copy(s_prev, 1, 3))
      else writeln(fout, s);
      s_prev := s;
    end;
  end
  else writeln(fout, 'Условие не выполнено');
  close(fout);
  close(f);
end.

// ...
  reset(f);
  assign(fout, 'text_res.txt');
  rewrite(fout); // <---Вот сюда
  if (len_3 > len_min) and (len_3 < len_max) then
  begin
    s_prev := '';
    while not eof(f) do 
    begin
      readln(f, s);
      if s_prev <> '' then writeln(fout, s + Copy(s_prev, 1, 3))
      else writeln(fout, s);
      s_prev := s;
    end;
  end
  else writeln(fout, 'Условие не выполнено');
  close(fout);
  close(f);
// ...