Разработать программу, которая подсчитывает число слов в текстовом файле и собирает статистику

program A1;
 
const mx=10;
var s:string;
var d:array[1..mx] of string[20];
var c:array[1..mx] of byte;
var count:0..mx;
 
function NextWord(var s:string):string;
begin
     while (s<>'') and (s[1]=' ') do delete(s,1,1);
     NextWord:=copy(s,1,pos(' ',s)-1);
     delete(s,1,pos(' ',s));
end;
function Add(w:string):boolean;
         var a:integer;
         begin
              if w='' then Add:=false
              else begin
                   a:=1;
                   while (a<=count) and (d[a]<>w) do inc(a);
                   if a<=count then c[a]:=c[a]+1
                      else begin
                           inc(count);
                           d[count]:=w;
                           c[count]:=1;
                      end;
                   Add:=true;
              end;
         end;
procedure Sort;
          var a,b:integer;
          var ts:string;
          var ti:integer absolute ts;
          begin
               for a:=count downto 1 do
                   for b:=a-1 downto 1 do
                       if d[b]>d[b+1] then
                          begin
                               ts:=d[b];
                               d[b]:=d[b+1];
                               d[b+1]:=ts;
                               ti:=c[b];
                               c[b]:=c[b+1];
                               c[b+1]:=ti;
                          end;
 
          end;
procedure ShowList;
          var a:integer;
          begin
               for a:=1 to count do
                   begin
                        write('>');
                        write(d[a],' ',c[a]);
                        writeln;
                   end;
          end;
procedure ChangeString(var s:string);
          const letters : set of char = ['a'..'z','A'..'Z'];
          var a:integer;
          begin
               for a:=1 to length(s) do
                   if Not(s[a] in letters) then s[a]:=' ';
          end;
begin
write('<<');
readln(s);
s:=s+' '; {Last word must have a space after him}
ChangeString(s);
count:=0;
repeat
until not Add(NextWord(s));
Sort;
ShowList;
end.

PROGRAM CountWords(In_file, Out_file, Temp);
 
CONST
  MaxWords= 2000;
VAR
  In_file, Out_file, Temp: TEXT;
  Str: STRING;
  ArrWords: ARRAY[1..MaxWords] OF STRING[20];
  WordsCount: ARRAY[1..MaxWords] OF BYTE;
  Count: 0..MaxWords;
  Int: INTEGER;
  Ch: CHAR;
 
FUNCTION NextWord(VAR Str: STRING): STRING;
BEGIN
  WHILE (Str <> '') AND (Str[1]= ' ')
  DO
    DELETE(Str, 1, 1);
  NextWord:= COPY(Str, 1, pos(' ', Str) - 1);
  DELETE(Str, 1, pos(' ', Str));
END;
 
FUNCTION Add(Word: STRING): BOOLEAN;
VAR
  Int: INTEGER;
BEGIN
  IF Word= ''
  THEN
    Add:= FALSE
  ELSE
    BEGIN
      Int:= 1;
      WHILE (Int <= Count) AND (ArrWords[Int] <> Word)
      DO
        INC(Int);
      IF Int <= Count
      THEN
        WordsCount[Int]:= WordsCount[Int] + 1
      ELSE
        BEGIN
          INC(Count);
          ArrWords[Count]:= Word;
          WordsCount[Count]:= 1;
        END;
      Add:= TRUE;
    END;
END;
 
PROCEDURE Sort; 
VAR
  Int1, Int2: INTEGER;
  TempStr: STRING;
  TempInt: INTEGER;
BEGIN
  FOR Int1:= 1 TO Count
  DO
    FOR Int2:= Int1 - 1 DOWNTO 1
    DO
      IF ArrWords[Int2] > ArrWords[Int2 + 1]
      THEN
        BEGIN
          TempStr:= ArrWords[Int2];
          ArrWords[Int2]:= ArrWords[Int2 + 1];
          ArrWords[Int2 + 1]:= TempStr;
          TempInt:= WordsCount[Int2];
          WordsCount[Int2]:= WordsCount[Int2 + 1];
          WordsCount[Int2 + 1]:= TempInt;
        END;
END;
 
PROCEDURE ShowList; 
VAR
  Int: INTEGER;
BEGIN
  FOR Int:= 1 TO Count
  DO
    BEGIN
      WRITE(Out_file, '-');
      WRITE(Out_file, ArrWords[Int], ' ', WordsCount[Int]);
      WRITELN(Out_file);
    END;
END;
 
PROCEDURE ChangeString(VAR Str: STRING);
CONST
  Letters: SET OF CHAR = ['a'..'z','A'..'Z', '*'..'п','Ђ'..'џ'];
VAR
  Int: INTEGER;
BEGIN
  FOR Int:= 1 TO length(Str)
  DO
    IF NOT(Str[Int] IN Letters)
    THEN Str[Int]:= ' ';
END;
 
PROCEDURE CntWrds;
BEGIN
  RESET(Temp);
  READLN(Temp, Str);
  Str:= Str + ' '; 
  ChangeString(Str);
  REPEAT
  UNTIL NOT Add(NextWord(Str))
END;
 
 
BEGIN
  ASSIGN(In_file, 'D:\tp7\bin\infile.txt');
  ASSIGN(Out_file, 'D:\tp7\bin\outfile.txt');
  ASSIGN(Temp, 'D:\tp7\bin\Temp.txt');
  RESET(In_file);
  Str:= Str + ' '; 
  Count:= 0;
  WHILE NOT EOF(In_file)
  DO
    BEGIN
      REWRITE(Temp);
      FOR Int:=1 TO 256
      DO
        BEGIN
          READ(In_file, Ch);
          WRITE(Temp, Ch)
        END;
      CntWrds
     END;
 
  Sort;
  REWRITE(Out_file);
  ShowList;
  CLOSE(In_file);
  CLOSE(Out_file);
END.

WHILE NOT EOF(In_file)
  DO
    BEGIN
      REWRITE(Temp);//Это сколько же раз Вы открываете файл для записи? на каждый символ?
      FOR Int:=1 TO 256//зачем это? Считывайте файл построчно и обрабатывайте строки как Вам нужно
      DO
        BEGIN
          READ(In_file, Ch);
          WRITE(Temp, Ch)
        END;
      CntWrds
     END;

var s:string;
.............................
REWRITE(Temp);
RESET(In_file);
WHILE NOT EOF(In_file)  DO
    BEGIN
      READLN(In_file,s);
      //обрабатываем строку
     //делаем что надо
   END;