В тексте найти все слова, у которых буква встречается более одного раза

program string12;
uses crt;
var t:string;
a:array[1..255] of string;
i,j,k,kb,sch,ksl,k2:integer;
ch:char;
mn:set of char;
begin
clrscr;
mn:=[',','.',' ','!',';',':'];
writeln('Vvedi text');
readln(t);
t:=t+'.';
kb:=0;ksl:=0;
for i:=1 to length(t) do
if not(t[i] in mn) then inc(kb)
else
if kb>0 then
begin
inc(ksl);
for j:=i-kb to i-1 do
for k:=j+1 to i do
if t[j]=t[k] then
begin
inc(sch);
write('slovo nomer ',ksl, ',v nem bukv=',kb,',povtor bukva-',t[j],' ona v slove=',i,' v stroke:=',j,' i ',j-kb+i);
writeln;
end;
if sch>2 then
begin
write(' V etom slove - "');for k:=j-kb to j-1 do write(t[k]);write('" bolse 2 odinakovih');
end;
sch:=0;
kb:=0;
end;
readkey;
end.

var
 a: array ['a'..'z'] of byte;
 a2: array [1..200] of string;
 i,j: integer;
 s,slovo, sout, sout2: string;
 c: char;
 
procedure sbros;
var
 c: char;
begin
 for c:='a' to 'z' do
  a[c]:=0;
end;
 
procedure poisk(var as: string);
var
 i: integer;
begin
slovo:='';
while as<>'' do
begin
 if as[1] in ['a'..'z'] then
 begin
  slovo:=slovo+as[1];
  delete(as,1,1);
 end
 else
 begin
  delete(as,1,1);
  break;
 end;
end;
end;
 
 
begin
 sout:='';
 write('Vvedite text: ');
 readln(s);
 for i:= 1 to 200 do
  a2[i]:='';
 
 while s<>'' do
 begin
 sbros;
 poisk(s);
 for i:=1 to length(slovo) do
 begin
  inc(a[slovo[i]]);
  if a[slovo[i]]>1 then
  begin
   sout:=sout+slovo+' ';
   break;
  end;
 end;
 end;
 
 while sout<>'' do
 begin
  poisk(sout);
  a2[length(slovo)]:=a2[length(slovo)]+slovo+' ';
 end;
 
 for i:= 1 to 200 do
  sout2:=sout2+a2[i];
 writeln;
 writeln(sout2);
 readln;
end.

program Project1;
 
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  //Наибольшее количество слов.
  M = 100;
type
  //Запись для хранения сведений о слове.
  TInfo = record
    SWord : String; //Слово.
    Len : Integer; //Длина слова.
  end;
var
  S : String;
  Arr : array[1..M] of TInfo; //Массив слов.
  Info : TInfo;
  Da : set of Char;
  i, j, k, Len, LenW : Integer;
  F : Boolean;
begin
  repeat
    Writeln('Задайте строку:');
    Readln(S);
    S := UpperCase(S); //Приводим буквы к верхнему регистру. Работает только для латиницы.
    
    //Находим слова, в которых есть повторы букв.
    Len := Length(S);
    LenW := 0; //Длина очередного слова.
    Da := []; //Множество букв в очередном слове.
    F := False; //Есть ли в текущем слове повторяющиеся буквы.
    j := 0; //Индекс для массива слов.
    for i := 1 to Len do begin //Перебор символов строки.
      if not (S[i] in D) then begin //Если символ не является разделителем.
        Inc(LenW); //Учитываем очередную букву в длине слова.
        if S[i] in Da then F := True; //Проверяем, есть ли в слове такая же буква.
        Da := Da + [S[i]]; //Добавляем букву во множество.
        if (i = Len) or (S[i + 1] in D) then begin //Отслеживаем конец слова.
          //Если в слове есть повторы букв, то добавляем его в массив.
          if F then begin
            Inc(j);
            Arr[j].SWord := Copy(S, i - LenW + 1, LenW);
            Arr[j].Len := LenW;
          end;
          LenW := 0; //Сброс длины слова.
          Da := []; //Обнуление множества букв.
          F := False; //Сброс флага.
        end;
      end;
    end;
 
    //Теперь сортируем массив по неубыванию (нестрогому возрастанию) длин слов.
    //Сортировка методом вставок.
    for i := 1 to j do begin
      k := i;
      Info := Arr[k];
      while (k > 1) and (Arr[k - 1].Len > Info.Len) do begin
        Arr[k] := Arr[k - 1];
        Dec(k);
      end;
      Arr[k] := Info;
    end;
 
    //Распечатка результата.
    if j > 0 then begin
      Writeln('Перечень слов, в которых есть повторы букв, в порядке возрастания длин:');
      for i := 1 to j do begin
        if i > 1 then Write(', ');
        Write(Arr[i].SWord);
      end;
      Writeln;
    end else
      Writeln('В тексте нет ни одного слова с повторящимися буквами.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.