Множества: Напечатать в алфавитном порядке: все гласные буквы, которые входят в каждое слово

Program mn;
uses crt;
 
procedure Task;
const t1:array[1..6] of char = ('а','е','ё','и','о','у','ю','я','э','ы');
const t2:set of char = ['а','е','ё','и','о','у','ю','я','э','ы'];
var s,t,r:string;
i:integer;
begin
readln(s);
i:=pos('.',s);
delete(s,i,length(s)-i+1);
s:=s+',';
t:=s;
for i:=1 to 6 do {for each char}
  begin
    while pos(',',s)<>0 do
      if pos(t1[i],copy(s,1,pos(',',s)))<>0 then delete(s,1,pos(',',s)) else break;
    if s='' then write(t1[i]);
    s:=t;
  end;
write(' ');
for i:=ord('a') to ord('z') do {for each char}
  if not(chr(i) in t2) then
  begin
    while pos(',',s)<>0 do
      if pos(chr(i),copy(s,1,pos(',',s)))=0 then delete(s,1,pos(',',s)) else break;
    if s='' then write(chr(i));
    s:=t;
  end;
end;
 
begin
Task;
readln;
end.

program mn;
uses crt;
 
procedure Task;
const t1:array[1..10] of char = ('а','е','ё','и','о','у','ю','я','э','ы');
const t2:set of char = ['а','е','ё','и','о','у','ю','я','э','ы'];
var s,t,r:string;
i:integer;
begin
readln(s);
i:=pos('.',s);
delete(s,i,length(s)-i+1);
s:=s+',';
t:=s;
for i:=1 to 10 do {for each char}
  begin
    while pos(',',s)<>0 do
      if pos(t1[i],copy(s,1,pos(',',s)))<>0 then delete(s,1,pos(',',s)) else break;
    if s='' then write(t1[i]);
    s:=t;
  end;
write(' ');
for i:=ord('а') to ord('я') do {for each char}
  if not(chr(i) in t2) then
  begin
    while pos(',',s)<>0 do
      if pos(chr(i),copy(s,1,pos(',',s)))=0 then delete(s,1,pos(',',s)) else break;
    if s='' then write(chr(i));
    s:=t;
  end;
end;
 
begin
Task;
readln;
end.

program mn; Uses Crt;
Type TMas=array['a'..'z'] of Integer;
Var Ch:Char;
    t1:TMas;
    k:Integer;
procedure Task;
{const t2:set of char = ['а','е','ё','и','о','у','ю','я','э','ы'];}
var
   s,t,r:string;
 
   t2:Set Of Char;
   i:integer;
   Ch:Char;
begin
Writeln('stroka = '); readln(s);
k:=0;
 
While s<>'' Do Begin
      i:=1; t2:=[];
      While (s[i]<>',')and(s<>'') Do Begin
            If Not (s[i] in t2) Then Begin
               Inc(t1[s[i]]);
               t2:=t2+[s[i]];
            End;
            Inc(i);
      End;
      Delete(s,1,i);
      Inc(k);
End;
End;
 
begin
Task;
For Ch:='a' To 'z' Do If t1[Ch]=k Then Write(Ch:3);
readln;
end.