Дана непустая последовательность слов из строчных русских букв; между соседними словами — запятая, за последним словом — точка. Напечатать в алфавитном порядке все глухие согласные буквы, которые не входят только в одно слово. — Pascal(Паскаль)

uses crt;
const
gl=['к','п','с','т','ф','х','ц','ч','ш','щ','К','П','С','Т','Ф','Х','Ц','Ч','Ш','Щ'];{глухие согласные}
bk:string='КкПпСсТтФфХхЦцЧчШшЩщ';
type mnoz=set of char;
var  s,s1:string;
     m:array[1..100] of mnoz;{массив множеств}
     mn_ob,mn,mn1:mnoz;
     n,i,j:byte;
begin
clrscr;
repeat
writeln('Введите текст на русском языке, между словами пробелы:');
readln(s);
if pos(' ',s)=0 then
writeln('В предложении только одно слово. Повторите ввод.');
until pos(' ',s)>0;
s:=s+' ';{}
mn_ob:=[];
for i:=1 to length(s) do
if s[i] in gl then mn_ob:=mn_ob+[s[i]];
n:=0;
while pos(' ',s)>0 do{создаем массив множеств}
 begin
  s1:=copy(s,1,pos(' ',s)-1);{копируем очередное слово}
  n:=n+1;{считаем}
  m[n]:=[];{создаем множество}
  for j:=1 to length(s1) do
  if s1[j] in gl then m[n]:=m[n]+[s1[j]];{из его букв по условию}
  delete(s,1,pos(' ',s));{удаляем это слово}
 end;
mn1:=[];{множество цифр, не входящих только в одно число}
for i:=1 to n do{для каждого множества }
 begin
  mn:=[];
  for j:=1 to n do
  if j<>i then mn:=mn+m[j];{делаем множество из букв, котoрые входят в другие числа}
  mn1:=mn1+(m[i]-mn);{вычитаем из даннго множества общее множество
                      и остаток записываем в новое}
 end;
if mn1=[] then writeln('Цифр, которые не входят только в одно число, нет!')
else
 begin
  writeln('Цифры, которые не входят только в одно число:');
  for i:=1 to length(bk) do{идем по алфавиту,
  если буква есть в общем множестве и ее нет в котором по разу, выводим}
  if (bk[i] in mn_ob)and not (bk[i] in mn1) then write(bk[i],' ');
 end;
readln
end.

program Project1;
 
(*Возвращает заглавный вариант буквы для кодовой страницы CP866.*)
function UpperCase(const aCh : Char) : Char;
begin
  case aCh of
  'а'..'п' : UpperCase := Char( Ord(aCh) - $20);
  'р'..'я' : UpperCase := Char( Ord(aCh) - $50);
  'ё'      : UpperCase := 'Ё';
  else
    UpperCase := UpCase(aCh);
  end;
end;
 
(*Находит в тексте aStr слова, содержащие глухие согласные буквы кириллицы,
и распечатывает их.*)
function GetWords(const aStr : String) : String;
const
  (*Множество разделителей.*)
  Delims = [' ', '.', ',', ':', ';', '!', '?', '-', Char(9)];
  (*Множество глух. согласных букв кириллицы.*)
  Ab = ['К', 'П', 'С', 'Т', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ'];
var
  (*Индекс символов в строке.*)
  i : Integer;
  (*Индекс конца очередного слова.*)
  Pos2 : Integer;
  (*Отдельные слова в тексте.*)
  StrTmp : String;
  (*Результирующая строка.*)
  StrRes : String;
  (*Флаг, показывающий - найдена ли хотябы одна глухая согласная буква в слове.*)
  IsFound : Boolean;
begin
  StrRes := '';
  StrTmp := '';
  IsFound := False;
  Pos2 := 0;
  for i := 1 to Length(aStr) do begin
    (*Если очередной символ является разделителем - пропускаем итерацию.*)
    if aStr[i] in Delims then Continue;
 
    (*Обрабатываем очередную букву слова.*)
    StrTmp := StrTmp + aStr[i];
    if UpperCase(aStr[i]) in Ab then IsFound := True;
    //Отслеживаем конец слова.
    if i = Length(aStr) then
      Pos2 := i
    else if aStr[i + 1] in Delims then
      Pos2 := i
    ;
    //Если конец слова найден.
    if Pos2 > 0 then begin
      if IsFound then begin
        if StrRes <> '' then StrRes := StrRes + ', ';
        StrRes := StrRes + StrTmp;
      end;
      StrTmp := '';
      IsFound := False;
      Pos2 := 0;
    end; //if Pos2 > 0
  end; //for i
 
  GetWords := StrRes;
end;
 
var
  StrSrc, StrRes, StrTmp : String;
begin
  repeat
    Writeln('Введите строку:');
    Readln(StrSrc);
    StrRes := GetWords(StrSrc);
    Writeln('Слова, в которых встречаются глухие согласные буквы:');
    Writeln(StrRes);
    Writeln('Повторить - ENTER. Выход - любой символ + ENTER.');
    Readln(StrTmp);
  until StrTmp <> '';
end.