Множества. Вывести строчные согласные буквы, которые входят только в одно слово

Uses CRT;
Const n=['а'..'я'];
var s:string;
    a,b:set of char;
    i:integer;
    ch:char;
    mas:array[char] of integer;
begin
ClrScr;
a:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч'];
b:=[];
     Write('S=');Read(s);
     for i:=1 to length(s) do
     if s[i] in a then
     begin
          b:=b+[s[i]];
          inc(mas[s[i]]);
     end;
     for ch:=char(0) to char(255)  do
     if ch in b then begin
           write(ch,' ');
           writeln(mas[ch]);
      end;
end.

Uses CRT;
Const n=['а'..'я'];
var s:string;
    a,b:set of char;
    i:integer;
    ch:char;
    mas:array[char] of integer;
procedure Bce;
begin
a:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч'];
b:=[];
     Write('S=');Read(s);
     for i:=1 to length(s) do
     if s[i] in a then
     begin
          b:=b+[s[i]];
          inc(mas[s[i]]);
     end;
     for ch:=char(0) to char(255)  do
     if ch in b then begin
           write(ch,' ');
           writeln(mas[ch]);
      end;
end;
Begin
     ClrScr;
     Bce;
end.

Uses CRT;
Const n=['а'..'я'];
var s:string;
    a,b:set of char;
    i,j:integer;
    ch:char;
    mas:array[char] of integer;
procedure Bce;
begin
a:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч'];
b:=[];
i:=1;
     Write('S=');Read(s);
     for i:=1 to Length(s) do
     if s[i]=' ' then j:=i;
     for i:=1 to j do
     if s[i] in a then
     begin
          b:=b+[s[i]];
          inc(mas[s[i]]);
     end;
     for ch:=char(0) to char(255)  do
     if ch in b then begin
           write(ch,' ');
           writeln(mas[ch]);
      end;
end;
Begin
     ClrScr;
     Bce;
end.

Uses CRT;
Const n=['а'..'я'];
var s:string;
    a,b:set of char;
    i,j:integer;
    ch:char;
    mas:array[char] of integer;
procedure Bce;
begin
a:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ'];
b:=[];
i:=1;
     Write('S=');Read(s);
     for i:=1 to Length(s) do
     if s[i]=' ' then
     begin
          j:=i;
          break;
     end;
     for i:=1 to j do
     if s[i] in a then
     begin
          b:=b+[s[i]];
          inc(mas[s[i]]);
     end;
     for ch:=char(0) to char(255)  do
     if ch in b then begin
           write(ch,' ');
           writeln(mas[ch]);
      end;
end;
Begin
     ClrScr;
     Bce;
end.

var
    s,s1 : string;
   sg,mn : set of char;
   i,j,k : byte;
       c : char;
 
 
procedure  sogl;
var  i,j,k:Byte;
 
begin
 
  sg := ['а'..'я'] - ['а', 'о', 'у', 'э', 'е', 'ы', 'и'];
 
   for i:=1 to length(s) do
      begin
 
         k := 0;
 
         for j:=1 to  length(s) do
 
            if s[i] = s[j]
              then
                k := k + 1;
          
         if (k < 2) and
            (s[i] in sg)
            then
               s1 := s1 + s[i];
 
      end;
 
   for i:=1 to length(s1) do
      if not(s1[i] in sg)
         then
            delete(s1,pos(s1[i],s1),1);
            end;
     
     
     procedure print ;
     var c:char;
     begin
        readln(s);
 
 
   for c:='а' to 'я' do
      if pos(c,s1) <> 0
         then
            writeln(c);Readln(c);
      end;
 
Begin
   setconsolecp(1251);
setconsoleoutputcp(1251);
  Write('введите строчку  ');
  Read(s);
  sogl;
  print;
 
 
end.

uses crt;
const cset=['б'..'д','ж','з','к'..'н','п','р'..'т','ф'..'щ'];
 
type
  arstring=array[1..3] of string;
  arset=array[1..3] of set of char;
  tset=set of char;
 
procedure readset(var aa:arset;var ab:tset);
var
  s:arstring;
  i,j:byte;
begin
  for i:=1 to 3 do  begin
    readln(s[i]);
    aa[i]:=[];
    for j:=1 to Length(s[i]) do
      aa[i]:=aa[i]+[s[i][j]];
  end;
  ab:= [];
  for i:=1 to 3 do
    ab:= ab+(aa[i]-aa[i mod 3+1]-aa[(i+1) mod 3+1]);
  ab:=ab*cset;
end;
 
procedure writeset(var ab:tset);
var i:byte;
begin
  for i:=1 to 255 do
    if chr(i) in ab then
      write(chr(i),' ');
end;
 
var
  a:arset;
  b:tset;
begin
  clrscr;
  writeln('Введите 3 слова');
  readset(a,b);
  writeset(b);
  readln
end.