Перебрать все возможные комбинации заданных символов

{ ãåíåðàöèÿ ïåðåñòàíîâîê }
uses crt;
const n = 4; { êîëè÷åñòâî ýëåìåíòîâ â ïåðåñòàíîâêå}
var a:array[1..n] of integer;{èíäåêñû ñèìâîëîâ}
    b:array [1..n] of char; {çàäàííâå ñèìâîëû}
procedure generate (l,r:integer);
var i,v,k:integer;
begin
k:=0;
if (l=r) then
 begin
  for i:=1 to n do write(b[a[i]],' ');
  writeln;
  k:=k+1;
  if k mod 22=0 then
   begin
    write('Press enter');
    readln
   end
 end
else
 begin
  for i :=l to r do
   begin
    v:=a[l]; a[l]:=a[i]; a[i]:=v; {îáìåí a[i],a[l]}
    generate(l+1,r); {âûçîâ íîâîé ãåíåðàöèè}
    v:=a[l]; a[l]:=a[i]; a[i]:=v; {îáìåí a[i],a[l]}
   end;
 end;
end;
 
var j:integer;
begin
randomize;
for j:=1 to n do
 begin
  b[j]:=chr(j+64); {çàäàåì íàïðèìåð ïðîïèñíâå ëàòèíñêèå áóêâû}
  a[j]:=j;
 end;
generate(1,n);
end.

{ Алгоритм Нарайаны — нерекурсивный алгоритм, генерирующий по данной
 перестановке следующую за ней перестановку (в лексикографическом порядке).
 Придуман индийским математиком Пандитом Нарайаной в XIV веке. 
 
Каждая следующая перестановка строится следующим образом:
 
    На первом шаге программы, двигаясь с конца массива, сравниваем соседние
    элементы, если предыдущий (по расположению в массиве) элемент больше
    следующего, двигаемся дальше, если меньше, останавливаемся и запоминаем
    его номер (m), этот элемент будет изменен (на этом шаге он отмечается
    красным треугольником снизу, а потом просто красным цветом).
    
    Элементы, стоящие слева от m-го, не изменяем (они станут окрашенными
    в серый цвет). Среди элементов, стоящих справа, нужно выбрать элемент (k),
    который должен встать на место m-го. Это минимальный элемент среди тех,
    которые больше m-го (отмечается синим треугольником, потом просто
    синим цветом).
    
    Меняем m-ый и k-ый элементы.
    Осталось упорядочить по возрастанию элементы, стоящие справа от нового m-го
    элемента, но т.к. они упорядочены по убыванию, достаточно их обернуть. }
    
Var RS : String;
 
Function StRevers(St :String) : String;
Var
  ii  : Longint;
  St0 : String;
Begin
  St0:='';
 For ii:=length(St) downto 1 do
  St0:=St0+St[ii];
  StRevers:=St0;
end;
 
Function LexNext(S : String) : String;
Var
  len,m,k,t : Longint;
  Sch       : Char;
  cs        : String;
  flag      : Boolean;
Begin
  len:=Length(S); flag:=True;
  For m:=len-1 downto 1 do
    If S[m]<S[m+1] then Break;
  For k:=len downto m+1 do
    If S[k]>S[m] then
    Begin
      flag:=False;
      Break;
    end;
  If flag then LexNext:='' else
  Begin
    For t:=len downto m+1 do
      If (S[t]>S[m]) and (S[t]<=S[k]) then k:=t;
    cs:=S;
    Sch:=cs[m];
    cs[m]:=cs[k];
    cs[k]:=Sch;
    LexNext:=Copy(cs,1,m)+StRevers(Copy(cs,m+1,len-m));
  end;
end;
 
Begin
  RS:='abcd';
  While RS<>'' do
  Begin
    Writeln(RS);
    RS:=LexNext(RS);
  end;
end.