program Project1;
const
(*Множество разделителей слов.*)
D = [' ', '.', ',', ':', ';', '!', '?', Char(9), Char(10), Char(13)];
var
(*Исходная строка, очередное слово строки.*)
StrSrc, StrWord : String;
(*Массив выделенных из строки слов.*)
ArrWords : array[1..100] of String;
(*i, j, k - Индексы элементов,
Pos2 - флаг конца слова,
Cnt - количество выделенных из строки слов.
CntS - счётчик совпадающих букв.
CntRes - минимальная неповторяющаяся часть.*)
i, j, k, Pos2, Cnt, CntS, CntRes: Integer;
function Min(const aV1, aV2 : Integer) : Integer;
begin
if aV1 <= aV2 then Min := aV1
else Min := aV2;
end;
begin
repeat
Writeln('Введите строку:');
Readln(StrSrc);
(*Выделяем слова и помещаем их в массив ArrWords.*)
Pos2 := 0;
Cnt := 0;
StrWord := '';
for i := 1 to Length(StrSrc) do begin
(*Пропускаем разделители.*)
if StrSrc[i] in D then Continue;
(*Добавляем к очередному слову символы, которые не являются разделителями.*)
StrWord := StrWord + StrSrc[i];
(*Отслеживаем конец очередного слова.*)
if i = Length(StrSrc) then
Pos2 := i
else if StrSrc[i + 1] in D then
Pos2 := i
;
(*Если конец слова найден.*)
if Pos2 > 0 then begin
Inc(Cnt);
ArrWords[Cnt] := StrWord;
(*Обнуляем сведения по слову.*)
StrWord := '';
(*Обнуляем флаг конца слова.*)
Pos2 := 0;
end;
end;
(*Определяем минимальную неповторяющуюся часть.*)
CntRes := 0;
for i := 1 to Cnt - 1 do begin
for j := i + 1 to Cnt do begin
CntS := 0;
for k := 1 to Min( Length(ArrWords[i]), Length(ArrWords[j]) ) do begin
(*
Если требуется сверять буквы независимо от регистра, тогда так:
if UpCase(ArrWords[i][k]) = UpCase(ArrWords[j][k]) then
*)
if ArrWords[i][k] = ArrWords[j][k] then
Inc(CntS)
else
Break
;
end;
if CntS > CntRes then CntRes := CntS;
end;
end;
CntRes := CntRes + 1;
Writeln('Длина минимальной неповторяющейся части = ', CntRes);
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(StrSrc);
until StrSrc <> '';
end.