Дана строка символов. Построить множество гласных символов, которые встречаются больше одного раза.

program xxx;
var
 s:string;
 i:integer;
 hm:array[1..10]of integer;
begin
 writeln('Введите строку');
 readln(s);
 for i:=1 to length(s) do case ord(s[i]) of
  'а':hm[1]:=hm[1]+1;
  'е':hm[2]:=hm[2]+1;
  'ё':hm[3]:=hm[3]+1;
  'и':hm[4]:=hm[4]+1;
  'о':hm[5]:=hm[5]+1;
  'у':hm[6]:=hm[6]+1;
  'ы':hm[7]:=hm[7]+1;
  'э':hm[8]:=hm[8]+1;
  'ю':hm[9]:=hm[9]+1;
  'я':hm[10]:=hm[10]+1;
 end;
 for i:=1 to 10 do if hm[i]>1 then write(hm[i]:2);
 readln;
end.

uses crt;
{множества латинских и русских гласных букв}
const gll=['A','a','E','e','I','i','O','o','U','u','Y','y'];
      glr=['А','а','Е','е','Ё','ё','И','и','О','о','У','у','Э','э','Ю','ю','Я','я','ы'];
var s:string;
    a,b:set of char;{2 множества}
    i:integer;
begin
clrscr;
write('s: ');readln(s);
writeln;
a:=[];b:=[];{сначала они пустые}
for i:=1 to length(s) do
if ((s[i] in gll)or (s[i] in glr)) and not (s[i] in a) then{если гласная и ее нет в первом множестве}
a:=a+[s[i]]{записывыем}
else if ((s[i] in gll)or (s[i] in glr)) and (s[i] in a) then b:=b+[s[i]];{если есть в первом, записываем во второе}
for i:=65 to 241 do{перебираем интервал кодов, куда попадают буквы}
if chr(i)in b{если символ есть во втором множестве}
then write(chr(i),' ');{выводим на экран}
readln
end.

unit massiv;
interface
const nmax=1000;
type Tmas=array[1..nmax]of integer;
procedure Vvod(var x:integer;var m:Tmas);
procedure Vyvod(var x:integer;var m:Tmas);
Procedure MinMax(x:integer;m:Tmas; var mn,imn,mx,imx:integer);
implementation
procedure Vvod(var x:integer;var m:Tmas);
var i:integer;
begin
repeat
write('Vvedite razmer massiva:  ');
readln(x);
until (x>0)and(x<=nmax);
for i:=1 to x do
m[i]:=random(100);
end;
procedure Vyvod(var x:integer;var m:Tmas);
var i:integer;
begin
for i:=1 to x do
write(m[i],' ');
writeln;
end;
Procedure MinMax(x:integer;m:Tmas; var mn,imn,mx,imx:integer);
var i:integer;
begin
mn:=m[1];imn:=1;mx:=m[1];imx:=1;
for i:=1 to x do
if m[i]<mn then
  begin
    mn:=m[i];
    imn:=i;
  end
else if m[i]>mx then
  begin
    mx:=m[i];
    imx:=i;
  end;
writeln('Min element=',mn,' ego nomer=',imn);
writeln('Max element=',mx,' ego nomer=',imx);
end;
end.

uses crt,massiv;
var a:Tmas;
    n,min,imin,max,imax:integer;
begin
clrscr;
randomize;
Vvod(n,a);
writeln('Massiv A:');
Vyvod(n,a);
MinMax(n,a,min,imin,max,imax);
readln
end.