Множества. Паскаль

[Nika_]

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

Вот что получилось:

uses crt;
const glas=['a','e','i','o','u','y'];
type mn=set of char;
function Slovo(const s: string; var i: byte):string;
Var w: string;
Begin
w:='';
While (i<=length(s)) and (s[i] <> ',') do
 begin
 w:=w+s[i];
 i:=i+1;
 end;
slovo:=w;
end;
var s,s1:string;
    sl:array[1..100] of string;
    mres:mn;
    m:array[1..100] of mn;
    i,j,k:byte;
begin
clrscr;
writeln('Введите слова через запятую в конце точка');
readln(s);
i:=1;
k:=0;
while i<=length(s) do
 begin
  If (s[i]=',') or (s[i]='.') then
  begin
   k:=k+1;
   s1:='';
   s1:=slovo(s,i);
   i:=i+1;
   sl[k]:=s1;
  end;
 end;
 
for i:=1 to k do
 begin
  m[i]:=[];
  for j:=1 to length(sl[i]) do
  if sl[i][j] in glas then 
  include(m[i],sl[i][j]);
 end;
mres:=glas;
for i:=1 to k do
mres:=mres*m[i];
if mres=[] then
write('Гласных букв, входящих во все слова, нет')
else 
 for i:=65 to 241 do
 if chr(i) in mres then write(chr(i),' ');
readln;
end.

Помогите найти ошибку!

[Stilet]

А чем сей код не угодил?

[Nika_]

где-то зацикливается

[Aleksandr H.]

Program HelloWorld(output);
const glas=['a','e','i','o','u','y'];
var s,sl:string;i,j,k:integer;c:char;
begin
  s := 'Hello,worlda.';
  writeln(s);
  sl :='';s1:='';
  for i:=1 to Length(s) do 
   begin
    if not (s[i] in ['.',',']) then 
            sl := sl + s[i];
    else
        begin
          for j := length(sl) downto 1 do
            if not(sl[j] in glas) then delete(sl,j,1)
          
          for j := 1 to length(sl) do
          for k := j to length(sl) do
            if sl[j]>sl[k] then
              begin
                c := sl[j];
                sl[j]:=sl[k];
                sl[k]:=c
              end;
                   
          write(sl,' ') ;
          sl:=''; 
        end;
    end;
end.