Определить для каждого символа текста, сколько раз он встречается в тексте и вывести в текстовый файл слово

const
  p = [' ', '.', ',', '!', '?'];
 
 
var
  t, g: text;
  a: array [192..255] of integer;
  s, sl, slmax: string;
  i, j, k, ch, imax: byte;
 
begin
  assign(t, 'in.txt');
  assign(g, 'out.txt');
  reset(t);
  while not (eof(t)) do
  begin
    readln(t, s);
    for i := 1 to length(s) do
      if ord(s[i]) > 191 then inc(a[ord(s[i])]);
  end;
  imax := 192;
  writeln('Частота повторений символов в тексте');
  for i := 192 to 255 do
  begin
    write(chr(i):3, '-', a[i]:3, '         ');
    if a[i] > a[imax] then imax := i;
  end;
  writeln;
  writeln('Чаще всего (', a[imax], ') встречается ', chr(imax));
  reset(t);
  ch := 0;
  while not (eof(t)) do
  begin
    readln(t, s);
    s := s + ' ';
    sl := '';
    for i := 1 to length(s) do
      if not (s[i] in p) then sl := sl + s[i] else
      if length(sl) > 0 then
      begin
        k := 0;
        for j := 1 to length(sl) do
          if sl[j] = chr(imax) then inc(k);
        if k > ch then
        begin
          slmax := sl;
          ch := k;
        end;
        sl := '';
      end;
  end;
  rewrite(g);
  writeln('Символ ', chr(imax), ' чаще всего встретился в слове ', slmax);
  writeln(g, 'Символ ', chr(imax), ' чаще всего встретился в слове ', slmax);
  close(t);
  close(g);
end.

var f: file of char;
    rezult: text;
    
procedure words(symbol: char);
const p=[' ','.',',','!','?','-',';',':', #0, #8, #9, #10, #13, #27];
var fraction: real;
    slovo,firstword,lastword: string;
    i,k,kk: byte;
    c: char;
    kolsym: integer;
 
procedure Count(symbol: char; var kolsym: integer);
var c: char;
begin
kolsym:=0;
reset(f);
append(rezult);
while not (eof(f)) do
  begin
  read(f,c);
  if c=symbol then inc(kolsym);
  end;
close(rezult);
end;
 
function MaxFraction: real;
var max: real;
begin
slovo:='';
max:=0;
reset(f);
while not (eof(f)) do
  begin
  read(f,c);
  if not (c in p) then slovo:=slovo+c else
    begin
    k:=0;
    for var i:=1 to length(slovo) do
      if slovo[i]=symbol then inc(k);
    if k/length(slovo)>max then max:=k/length(slovo);
    slovo:='';
    end;
  end;
MaxFraction:=max;
end;
 
begin
Count(symbol,kolsym);
if kolsym>0 then
  begin
  append(rezult);
  kk:=0;
  fraction:=MaxFraction;
  reset(f);
  writeln(rezult,' ');
  writeln(rezult,'Символ ',symbol,' встречается в тексте ',kolsym,' раз(а)');
  write(rezult,'Все слова, в которых чаще всего встречается символ ',symbol,': ');
  while not (eof(f)) do
    begin
    read(f,c);
    if not (c in p) then slovo:=slovo+c else
      begin
      if pos(symbol,slovo)<>0 then
        begin
        k:=0;
        for i:=1 to length(slovo) do
          if slovo[i]=symbol then inc(k);
        if k/length(slovo)=fraction then 
          begin
          inc(kk);
          lastword:=slovo;
          if kk=1 then firstword:=slovo;
          write(rezult,slovo,' ');
          end;
         end;
      slovo:='';
      end;
    end;
  writeln(rezult,' ');
  writeln(rezult,' Первое слово с максимальной долей символа ',symbol,' - ',firstword);
  writeln(rezult,' Последнее слово с максимальной долей символа ',symbol,' - ',lastword);
  close(f);
  close(rezult);
  end; 
end;
 
begin
assign(f,'D:\in.txt');
assign(rezult,'D:\out.txt');
reset(f);
seek(f,filesize(f));
write(f,' ');
for var q:='А' to 'я' do
    words(q);
      
end.