Количество слов, состоящих из одного, двух, трех и т.д. символов в текстовом файле

Program quontity;
Uses Crt;
type vector=array[1..20] of integer;
var
f,g:text;
n:integer;
procedure vvod(n:integer; var f:text);
 var
  k:integer;
  s:string;
   begin
    assign(f,'word.txt');
      rewrite(f);
       append(f);
        for k:=1 to n do begin
          readln(s);
           writeln(F,s);
            end;
          close(f);
         end;
procedure proverka(s:string; var A:vector);
   var
    i,j,k,n:integer;
    p:boolean;
     begin
 
      n:=Length(s);
      i:=1;
      p:=False;
 
      while (i<=n) and (length(s)<>0) do begin
       i:=i+1;
       j:=0;
        if s[1]=' ' then delete(S,1,1);
         if length(s)=0 then break;
           if s[1]<>' ' then begin
             while (s[1]<>' ') and not(p) do begin
               p:=length(s)=0;
                if p then break;
                 j:=j+1;
                  delete(S,1,1);
                   end;
                  A[j]:=A[j]+1;
                   if p then break;
                  end;
                   end;
                    end;
 
 procedure robota(var f,g:text);
   var
   A:vector;
    i:integer;
      s:string;
      begin
       assign(g,'word1.txt');
        rewrite(g);
         append(g);
          reset(f);
       for i:=1 to 20 do
         A[i]:=0;
      while not eof(f) do begin
     readln(F,s);
    proverka(s,A);
   if eof(f) then break;
    end;
 close(f);
  for i:=1 to 20 do
    writeln(g,'words with ',i,' letters is',' ',A[i]);
     close(g);
      end;
begin
 Clrscr;
 readln(n);
  vvod(n,f);
   robota(f,g);
    readln;
     end.