Вывести в другой текстовый файл количество слов одинаковой длины

uses crt;
var a: array [1..255] of string;
    s,sl: string;
    i,j,k,l,dmax,dmin: integer;
    f,g:text;
 
begin
 assign(f,'in.txt');
 assign(g,'out.txt');
 reset(f);
 
 readln(f,s);
 s:=s+' '; sl:=''; j:=0;
 dmax:=0; dmin:=length(s);
 for i:=1 to length(s) do
    if s[i]<>' ' then sl:=sl+s[i] else
       if length(sl)<>0 then
          begin
          inc(j);
          a[j]:=sl;
          if length(sl)<dmin then dmin:=length(sl);
          if length(sl)>dmax then dmax:=length(sl);
          sl:='';
          end;
 rewrite(g);
 for l:=dmin to dmax do
    begin
    k:=0;
    for i:=1 to j do
        if length(a[i])=l then
           inc(k);
    if k>0 then writeln(g,'Äëèíà ',l,'-',k);
    end;
 close(f);
 close(g);
end.

uses crt;
var a: array [1..255] of string;
    s,sl: string;
    i,j,k,l,dmax,dmin: integer;
    f,g:text;
 
begin
 assign(f,'in.txt');           //связываем переменную с текстом
 assign(g,'out.txt');          //связываем переменную с текстом
 reset(f);                    //открываем файл для чтения
 
 readln(f,s);                   //считываем файл в переменную s (в расчете на то, что там все в строку)
 s:=s+' '; sl:=''; j:=0;         //чтобы учитывать и последнее слово, добавляем пробел к строке
 dmax:=0; dmin:=length(s);        //изначально максимальную длину назначаю минимальной длине и наоборот, чтобы поиск вести эффективно
 for i:=1 to length(s) do              //перебираю символы строки в цикле
    if s[i]<>' ' then sl:=sl+s[i] else    //если символ не пробел, прибавляю его к слову
       if length(sl)<>0 then                 //иначе если длина полученного слова не равна 0
          begin
          inc(j);                             //увеличиваю счетчик массива строк
          a[j]:=sl;                                 //в массив помещаю выделенное слово
          if length(sl)<dmin then dmin:=length(sl);    //если слово меньше минимального, меняю значение минимальной длины
          if length(sl)>dmax then dmax:=length(sl);    //если слово длиннее максимального, меняю значение максимальной длины
          sl:='';                                   //обнуляю переменную для нового слова
          end;
 rewrite(g);                                    //открываю файл для записи
 for l:=dmin to dmax do                         //перебираю длины слов от минимальной до максимальной
    begin
    k:=0;                                      //изначально счетчик слов с заданной длиной равен 0
    for i:=1 to j do                          //перебираю массив слов
        if length(a[i])=l then                //если есть слова с такой длиной, увеличиваю счетчик
           inc(k);
    if k>0 then writeln(g,'Длина ',l,'-',k);  //если есть хоть одно слово с такой длиной, записываю в новый файл информацию
    end;
 close(f);                    //закрываю файлы
 close(g);
end.

read(f,s);

uses crt;
var a: array [1..255] of string;
    s,sl: string;
    i,j,k,l,dmax,dmin: integer;
    f,g:text;
 
begin
 assign(f,'in.txt');           //связываем переменную с текстом
 assign(g,'out.txt');          //связываем переменную с текстом
 reset(f);                    //открываем файл для чтения
                  //считываем файл в переменную s (в расчете на то, что там все в строку)
 j:=0;         //чтобы учитывать и последнее слово, добавляем пробел к строке
 dmax:=0; dmin:=length(s);        //изначально максимальную длину назначаю минимальной длине и наоборот, чтобы поиск вести эффективно
 while not (Eof(f)) do
 begin
 readln(f,s); s:=s+' '; sl:='';
 for i:=1 to length(s) do              //перебираю символы строки в цикле
    if s[i]<>' ' then sl:=sl+s[i] else    //если символ не пробел, прибавляю его к слову
       if length(sl)<>0 then                 //иначе если длина полученного слова не равна 0
          begin
          inc(j);                             //увеличиваю счетчик массива строк
          a[j]:=sl;                                 //в массив помещаю выделенное слово
          if length(sl)<dmin then dmin:=length(sl);    //если слово меньше минимального, меняю значение минимальной длины
          if length(sl)>dmax then dmax:=length(sl);    //если слово длиннее максимального, меняю значение максимальной длины
          sl:='';                                   //обнуляю переменную для нового слова
          end;
 rewrite(g);                                    //открываю файл для записи
 for l:=dmin to dmax do                         //перебираю длины слов от минимальной до максимальной
    begin
    k:=0;                                      //изначально счетчик слов с заданной длиной равен 0
    for i:=1 to j do                          //перебираю массив слов
        if length(a[i])=l then                //если есть слова с такой длиной, увеличиваю счетчик
           inc(k);
    if k>0 then writeln(g,'Длина ',l,'-',k);  //если есть хоть одно слово с такой длиной, записываю в новый файл информацию
    end;
 end;
 close(f);                    //закрываю файлы
 close(g);
end.