Дан символьный файл f, содержащий произвольный текст. Получить 10 наиболее часто встречающихся букв и число их появления

Uses Crt;
Const mn=['a'..'z','A'..'Z','а'..'я','А'..'Я'];
Var f:file of char;
    A:array[0..255] of byte;
    m:set of char;
    imax,n:byte;
    ch:char;
Begin
    ClrScr;
    writeln('Окончание ввода ввод " "');
    Assign(f,'in.dat');Rewrite(f);
    Repeat
     write('Введите букву: ');readln(ch);
     write(f,ch);
     if ch in mn then inc(A[ord(ch)]);
    Until ch=' ';
    n:=0;m:=[];
    Repeat
      imax:=0;
      inc(n);
      Reset(f);
      While (imax=0)and(not Eof(f)) do
      Begin
        read(f,ch);
        if (ch in mn)and not (ch in m) then imax:=ord(ch);
      End;
      While Not Eof(f) do
      Begin
        read(f,ch);
        if ch in mn then
         if (A[ord(ch)]>A[imax])and not (ch in m) then 
          imax:=ord(ch);
      End;
      if imax>0 then
      Begin
        writeln(n,' max = ',chr(imax),' встречается ',A[imax]);
        m:=m+[chr(imax)];
      End;
    Until (imax=0)or(n=10);
    Close(f);
    readln;
End.

program _strings;
 
const
 
 N = 10;
 filename = 'input.txt' ;
 
 
type
 
 TInfo  = record
  chr   : char;
  count : integer;
 end;
 
 TLetters = array [0..59] of Tinfo;
 
var
 
 fi           : text;
 inString     : string;
 letters      : TLetters;
 i            : byte;
 
procedure CheckChr(const inCHR:char;var aLetters:TLetters );
 const
  cLet= ['A'..'Z','А'..'Я'];
 var
  not_found    : boolean;
  j,h          : byte;
begin
 if inCHR in cLet then
 begin
  h:=aLetters[0].count;
  not_found:=TRUE;
  for j:=1 to h do
    if letters[j].chr = inCHR then
     begin
      inc(aLetters[j].count);
      not_found:=FALSE;
      break;
     end;
    if not_found then 
     begin
      inc(h);
      aLetters[h].chr:=inCHR;
      aLetters[h].count:=1;
     end;
  aletters[0].count:=h;     
 end;
end;
 
procedure UpString(var instr:string);
{переписывает instr в верхнем регистре}
 const
  eng_alph = ['a'..'z','A'..'Z'];
  rus_alph = ['а'..'я','А'..'Я'];
 var
  i,lnth      : integer;
begin
 lnth:=length(instr);
 for i:=1 to lnth do 
  begin
   if instr[i] in eng_alph then 
    if instr[i] in ['a'..'z'] then instr[i]:=CHR(ord(instr[i])-32);
   if instr[i] in rus_alph then 
    if instr[i] in ['а'..'я'] then instr[i]:=CHR(ord(instr[i])-32);
  end;
end;
 
procedure Sort(var Let:Tletters;left,right:byte);
 var
  l,r,m       : integer;
  temp        : TInfo;
begin
 l:=left;
 r:=right;
 m:=let[(l+r) div 2].count;
 repeat
  while let[l].count > m do inc(l);
  while let[r].count < m do dec(r);
  if l<=r then 
   begin
    temp:=let[l];
    let[l]:=let[r];
    let[r]:=temp;
    inc(l);dec(r);
   end;
 until l>r;
 if left< r then sort(Let,left,r);
 if l<right then sort(let,l,right);
end;
 
BEGIN
 
{ Assign & read text }
 assign(fi,filename);reset(fi);
 letters[0].count:=0;
 while not eof(fi) do
     begin
      Readln(fi,instring);
      UpString(instring);
      for i:=1 to length(instring) do CheckCHR(instring[i],letters);
     end;
 close(fi);
{ sort & output }
sort(letters,1,letters[0].count);
for i:=1 to N do writeln(letters[i].chr,' ',letters[i].count);
 
END.