while not eof(f) do begin
   read(f, ch);
   { если длина превысила 80 символов, или встретился перевод строки }
   if (ch = #13) or (len > 80) then begin
     { переходим на след. элемент массива строк }
     inc(i);
     if len > 80 then s[i] := ch
     else begin
       s[i] := ''; read(f, ch)
     end;
     len := 1; { длина снова = 1 }
   end
   { иначе просто добавить символ к текущей строке и увеличить ее длину }
   else begin
       s[i] := s[i] + ch; inc(len)
   end
 end;

program kursach;
uses crt,dos;
const n= 100;
var
t_in,t_out:text;{Исходный и форматированный файлы}
f_in,f_out:string;{Имена}
m : array[1..n] of string; i:integer;

{Анализируем вводимые данные.
 Если нажат ESC выходим из программы}
function inp_name:string;
var
bh:char;
n:byte;
ins:string;
begin
   ins:='';
   n:=0;
   bh:=readkey;
   repeat
    if ord(bh)=27
      then halt;
    if (ord(bh)=8)and(n>0)
      then begin
           gotoxy(wherex-1,wherey);
           write(' ');
           dec(n);
           ins:=copy(ins,1,length(ins)-1);
           gotoxy(wherex-1,wherey)
           end;
    if ord(bh)in[32..126]
      then begin
           inc(n);
           ins:=ins+bh;
           write(bh)
           end;
    bh:=readkey
    until ord(bh)=13;
    writeln;
    inp_name:=ins
end;


{Инициализируем файл.
 Проверяем существование.
 Спрашиваем путь}
procedure init;
var
exist:boolean;rec_ord:byte;

begin
writeln('Укажите путь к исходному файлу:');
write('=>');
f_in:=inp_name;

 repeat
  assign(t_in,f_in);
    {$I-}
     reset(t_in);          {проверка существования}
     exist:=IOResult=0;
    {$I+}
     if not exist
       then begin
             writeln('Ошибка!Неправильно Указан' + 
  ' путь к иcходному файлу или его просто не существует');
             writeln('Попpобуйте еще раз(Esc - выход)');
             write('=>');
             f_in:=inp_name;

             end;
 until exist;
 exist:=false;
  repeat
     writeln('В какой файл записать отформатированный текст?');
     write('=>');
     readln(f_out);
     if f_in = f_out
       then begin
            writeln('Вы действительно хотите перезаписать файл?');
            writeln('0-Yes 1-No');
            readln(rec_ord);
     if rec_ord= 0 then exist:=true else exist:=false;end else exist:=true;

  until exist;
end;

procedure formats;{Форматируем текст}
var ch:char;

begin
 while(not eof(t_in))and (i<=n) do
    begin
     read(t_in,ch);            {Считываем посимвольно данные из файла}
     if (ch=#13) or (ch=#10) then
{Если встречается перенос строки или длина
строки становится больше значения, записываем
в сл. элемент массива}
       begin
        while length(m[i])<81  do
         begin
          m[i]:=m[i] + ' ';
         end;
        read(t_in,ch);
       end;
     if (length(m[i]) >80) then
        begin
         inc(i);
         m[i]:='';
        end
     else m[i]:=m[i]+ch;
    end;
 while length(m[i])<81  do
   begin
    m[i]:=m[i] + ' ';
   end;
 writeln;
 writeln('Файл успешно отформатирован и записан: ', f_out);
 readln;
end;


procedure ends;{Записываем отфoрматированный текст в файл}
var c,z,l:integer;

begin
 c:=0;
 l:=1;
 assign(t_out,f_out);
 rewrite(t_out);
 writeln(t_out,
'------------------------------------------------------------------------------------');
 for z:=1 to i do begin
  writeln(t_out,'|',m[z],' |');inc( c );
   if (( z mod 25) = 0) or ( i= z) then
    begin
     writeln(t_out,
'------------------------------------------------------------------------------------');
     writeln(t_out,'| Strok in List ',c,'| List ',l);l:=l+1;
     writeln(t_out,
'------------------------------------------------------------------------------------');
     writeln;
     writeln;writeln;
     writeln(t_out,
'------------------------------------------------------------------------------------');
     c:=0;
    end;
  end;
 close(t_in);
 close(t_out);
end;
begin
 clrscr;
 writeln('===============================');
 writeln('Программа Форматирование текста');
 writeln('===============================');
 writeln;
 i:=1;
 init;
 formats;
 ends; {BCE}
 end.

procedure formats;{Форматируем текст}
var ch:char;
begin
while (not eof(t_in)) and (i <= n) do begin
  read(t_in, ch);
  if (ch = #13) or (ch = #10) then
    while length(m[i]) < 78 do m[i] := m[i] + #32
  else
    if length(m[i]) < 78 then begin
      m[i] := m[i] + ch
    end
    else begin
      inc(i);
      m[i] := ch; { <--- Здесь терялся символ }
    end;
end;

writeln;
writeln('Файл успешно отформатирован и записан: ', f_out);
readln;
end;