Вычислить все возможные комбинации символов

const n1=20; {Размерность множества}
var a,p:array[1..n1] of integer; 
    i,j,k,pp,min,n:integer; 
    flag:boolean; 
 
begin 
 writeln ('Введите размерность множества от 1 до ',n1);
 read (n); 
 for i:=1 to n do p[i]:=i; {Заполняем массив индексов}
 a:=p; {На самом деле массив a может быть заполнен произвольно} 
 for i:=1 to n do write(a[p[i]]:4);{вывод первой перестановки} 
 writeln; 
 flag:=false; 
 repeat 
  i:=n; 
  repeat 
   i:=i-1 
  until (p[i]<p[i+1]) or (i=1);{шаг 1 выполнен} 
  if p[i]<p[i+1] then begin 
   k:=i; 
   repeat 
    k:=k+1; 
   until (k=n)or(p[k+1]<p[i]); 
   min:=k;
   pp:=p[i];p[i]:=p[min];p[min]:=pp;{шаг 2 выполнен} 
   for k:=i+1 to (i+1+n) div 2 do begin 
    pp:=p[k]; {здесь делает перестановка}
    p[k]:=p[n+i+1-k]; 
    p[n+i+1-k]:=pp 
   end; {шаг 3 выполнен} 
   for i:=1 to n do write(a[p[i]]:4); {вывод перестановки}
   writeln; 
  end 
  else flag:=true 
 until  flag; 
end.

const n1=20; {Размерность множества}
var a:array[1..n1] of string[4];
    p:array[1..n1] of integer;
    i,j,k,pp,min,n:integer;
    flag:boolean;
 
function rand_str (len:integer):string;
var i:integer; s:string; x:byte;
begin
 for i:=1 to len do begin
  x:=64+(random(26)+1);
  insert (Chr(x),s,1);
 end;
 rand_str:=s;
end;
 
begin
 writeln ('Введите размерность множества от 1 до ',n1);
 read (n);
 for i:=1 to n do begin
  p[i]:=i; {Заполняем массив индексов}
  a[i]:=rand_str(5) {Массив заполняем случайными строками}
 end;
 for i:=1 to n do write(a[p[i]]:6);{вывод первой перестановки}
 writeln;
 flag:=false;
 repeat
  i:=n;
  repeat
   i:=i-1
  until (p[i]<p[i+1]) or (i=1);{шаг 1 выполнен}
  if p[i]<p[i+1] then begin 
   k:=i; 
   repeat 
    k:=k+1; 
   until (k=n)or(p[k+1]<p[i]); 
   min:=k;
   pp:=p[i];p[i]:=p[min];p[min]:=pp;{шаг 2 выполнен} 
   for k:=i+1 to (i+1+n) div 2 do begin 
    pp:=p[k]; {здесь делает перестановка}
    p[k]:=p[n+i+1-k]; 
    p[n+i+1-k]:=pp 
   end; {шаг 3 выполнен} 
   for i:=1 to n do write(a[p[i]],' '); {вывод перестановки}
   writeln; 
  end 
  else flag:=true 
 until  flag; 
end.

program pr;
var a:array[1..10] of string;
    razd,slovo,str:string;
    j,n,q:integer;
    kol : integer;
procedure generate (l,r:integer;var k:integer);
var i:integer;
v:string;
begin
if (L=r) then
  begin
    for i:=1 to n do begin
    write(a[i],'');
    end;
    writeln('');
    k:=k+1;
  end
else
  begin
    for i:=L to r do
      begin
        v:=a[L]; a[L]:=a[i]; a[i]:=v;
        generate(L+1,r,k);
        v:=a[L]; a[L]:=a[i]; a[i]:=v;
      end;
  end;
end;
begin
j:=1;
n:=0;
razd := ' ';
writeln('Введите исходную строку');
readln(str);
str:=str+' ';
for q := 1 to length(str) do
 begin
    if pos(str[q], razd) = 0 then
          slovo := slovo + str[q]
            else
     if length(slovo)>0 then  begin
      a[j]:=slovo;
      inc(j);
      inc(n);
      slovo:='';
end;end;
writeln('Результат:');
generate( 1,n,kol);
writeln('Перестановок: ',kol);
end.

program gg;
uses crt;
const a:set of byte=[3,5,8];
var 
    i,i2,i3:byte;
begin
for i:=0 to 9 do
for i2:=0 to 9 do
for i3:=0 to 9 do
if (i in a) and (i2 in a) and (i3 in a) then
writeln(i,i2,i3);
end.