Сузить текст.

Program lab8 (input, output);
var
f1,f2:text;
str: string;
restr: string;
i: integer;
       procedure mydelete(str2:string; var restr2:string);
        begin
         delete (str2, length(str2)-7, 8);
         restr2:=str2;
        end;
 
   begin
    assign(f1,'C:\laba8.txt');
    reset(f1);
    assign(f2, 'C:\redlaba8.txt');
    rewrite(f2);
    FOR I:=1 TO 80 DO
    begin
    READLN(F1,STR);
      mydelete(str, restr);
      writeln('text=',f1);
      writeln(f2, restr);
      end;
 
    close(f1);
    close(f2);
    readln;
   end.

const NewLens = 72;
 
procedure copyLens(var s : string; f : Text);
var t : String;
begin
  while Length(s) >= NewLens do
    begin
      t := Copy(s, 1, NewLens); Delete(s, 1, NewLens);
      WriteLn(f, t);
    end;
end;
 
var
  f1, f2 : text;
  s, t : string;
 
begin
  assign(f1, 'C:\laba8.txt'); reset(f1);
  assign(f2, 'C:\redlaba8.txt'); rewrite(f2);
  t := '';
  while Not EOF(f1) do
    begin
      ReadLn(f1, s);
      t := t + s;
      copyLens(t, f2);
    end;
  if Length(t) > 0 then WriteLn(f2, t);
  close(f1);
  close(f2);
end.

procedure mydelete(var str:string);
begin
delete (str,length(str)-7, 8);
end;
var f1,f2:text;
    str: string;
    restr: string;
    i: integer;
begin
assign(f1,'C:\laba8.txt');
reset(f1);
assign(f2, 'C:\redlaba8.txt');
rewrite(f2);
while not eof(f1) do
 begin
  readln(f1,str);
  mydelete(str);
  writeln(f2, str);
 end;
close(f1);
close(f2);
write('Строки файла C:\laba8.txt уменьшены и записаны в файл  C:\redlaba8.txt');
readln
end.