Определить, какие из слов строки повторяются чаще всего

const 
N=100;
 
var
words:array[1..N]of string;
w:array[1..N]of string;
cn,k:integer;
s:string;
wd:string;
i,j:integer;
index:integer;
count:integer;
cnt:integer;
max:integer;
wc:integer;
b:boolean;
 
function ParceText(txt:string):integer;
var l,c:integer;
begin
c:=0;
l:=length(txt);
for var i:=1 to l+1 do
begin
if ((txt[i]<>' ')and(i<>l+1)) then
wd:=wd+txt[i] 
else
begin
inc(c);
words[c]:=wd;
wd:='';
end;
end;
ParceText:=c;
end;
 
begin
writeln('Введите текст:');
readln(s);
count:=ParceText(s);
for i:=1 to count do
begin
cnt:=0;
for j:=1 to count do
if words[j]=words[i] then inc(cnt);
if cnt>max then
begin
max:=cnt;
index:=i;
end;
end;
 
writeln;
writeln('Чаще всего встречаются слова:');
 
for i:=1 to count do
begin
wc:=0;
for j:=1 to count do
if words[i]=words[j] then
inc(wc);
if wc=max then
begin
b:=true;
for k:=1 to cn do
if w[k]=words[i] then
b:=false;
if b then 
begin 
writeln(words[i]);
inc(cn);
w[cn]:=words[i];
end;
end;
end;
 
readln;
end.

var
  i,j,k,m:integer;
  s,t:string;
  a:array[1..128] of string;{массив уникальных слов}
  n:array[1..128] of integer;{количество повторов каждого слова}
procedure additem;{довавляем слово или увеличиваем счетчик повторов}
var
  k:integer;
begin
  if t<>'' then
  for k:=1 to j do if a[k]=t then begin{слово есть в списке - увеличиваем счетчик}
    n[k]:=n[k]+1;
    if n[m]<n[k] then m:=k;{заодно запоминаем индекс с максимальным числом повторов}
    t:='';
    break;
  end;
  if t<>'' then begin{слова в списке нет, добавляем}
   j:=j+1;
   n[j]:=1;
   a[j]:=t;
   t:=''
  end;
end;
begin
  i:=0;j:=0;m:=1; t:='';
  write('CTPOKA:'); readln(s);
  for i:=1 to length(s) do if s[i]<>' ' then t:=t+s[i] else additem;{разбираем на слова}
  additem;{не забывем про последнее слово}
  for i:=1 to j do begin
    if n[i]=n[m] then writeln(a[i]);{печатаем все слова равные количеству максимальных повторов}
  end;
end.