Напечатайте те гласные буквы строки, которые встречаются в каждом слове строки

Var s,sl:string;
    sGl:string[6];
    i:byte;
Begin
    write('Строка: ');readln(s);
    sGl:='AEIOUY';
    s:=s+' ';
    For i:=1 to Length(s) do
     s[i]:=UpCase(s[i]);
    While (Pos(' ',s)>0)and(sGl<>'') do
    Begin
      sl:=Copy(s,1,Pos(' ',s)-1);
      Delete(s,1,Pos(' ',s));
      if sl<>'' then
       For i:=Length(sGl) downto 1 do
        if Pos(sGl[i],sl)=0 then Delete(sGl,i,1);  
    End;
    if sGl<>'' then writeln(sGl) else writeln('Нету гласных входящих в каждое слово');
End.

const Glasn = ['A','E','I','O','U','Y'];
Var s : string;
    ch : char;
    glasAll, glasWord: set of char;
    i, lenWord, CountWord, GlasAllCount : byte;
Begin
  write('Строка: '); readln(s);
  s:=s+' ';
  glasAll := Glasn; {изначально считаем, что все гласные буквы входят в слово}
  CountWord := 0; {количество слов в строке}
  glasWord := []; {а гласные в текущем слове пока нет}
  lenWord := 0; {длина текущего слова пока ноль}
  For i:=1 to Length(s) do
  begin
    ch := UpCase(s[i]);
    if ch=' ' then  {конец слова}
      begin
         if lenWord>0 then begin
           inc(CountWord);
           glasAll := glasAll * glasWord;
           glasWord := [];
           lenWord := 0;
        end
      end
    else begin {буква слова}
      inc(lenWord);
      if ch In Glasn then Include(glasWord, ch);
    end;
  end;
 
  WriteLn;
  if CountWord=0 then WriteLn('В строке вообще ни одного слова нет!')
  else begin
    GlasAllCount := 0;
    for ch:=#0 to #255 do
      if ch in glasAll then Inc(GlasAllCount);
    if GlasAllCount = 0 then
      WriteLn('Нет гласных, входящих в каждое слово')
    else begin
      Write('Гласные, входящие в каждое слово:');
      for ch:=#0 to #255 do
         if ch in glasAll then Write(' ',ch);
      WriteLn;
    end;
  end;
End.