{*************************************************}
{* (c) 1996 by Yucon (Boris Sachsenberg)         *}
{* Compiler: Borland Pascal 7.0/Turbo-Pascal 7.0 *}
{*************************************************}
{$X+}                         {Extended Syntax wg. Readkey ohne Rckgabewert}
uses crt;                                                     {wegen Readkey}
const anz:longint=0;        {Anzahl der m”glichen Kombinationen, Startwert 0}
var wortx,                            {Nimmt Neue Positionen der Zeichen auf}
    wort:string;                 {String mit eingegebener Zeichenkombination}

procedure pch(l:byte);                                  {Rekursive procedure}
var z,y,i:byte;
begin
 y:=1;                                                             {Position}
 for i:=1 to l do                   {Alle m”glichen Positionen (1 bis L„nge)}
 begin
  repeat
   for z:=1 to length(wort)-l do{Alle schon vergebenen Positionen durchgehen}
   begin
    if y=byte(wortx[z]) then                       {Position schon vergeben?}
    begin
     inc(y);                                         {N„chste Positon w„hlen}
     if y>length(wort) then y:=1;                   {evtl. šberlauf anpassen}
     z:=0;break;                   {Schleife abbrechen, z=0 fr repeat until}
    end;
   end;
  until z>0;     {Bei Schleifenabbruch, nochmalige šberprfung d. neuen Pos.}
  wortx[length(wort)-l+1]:=chr(y);   {Positon des entspr. Zeichens speichern}
  if l>1 then pch(l-1);                {Recursiver Aufruf fr n„chste Stelle}
  inc(y);                                           {N„chste Position w„hlen}
 end;
 if l=1 then    {Wenn ein Wort fertig ist (=h”chste Recursionstiefe erreicht}
 begin
  for z:=1 to length(wort) do write(wort[byte(wortx[z])]);    {Wort ausgeben}
  writeln;inc(anz);                                          {Anzahl erh”hen}
  if (anz div 25)=(anz / 25) then readkey;
         {auf Tastendruck warten, wenn letzte Bildschirmzeile erreicht wurde}
 end;
end;

begin
 write('Bitte Buchstabenfolge eingeben (max 255 Zeichen): ');readln(wort);
 writeln;
 pch(length(wort));                 {Rekursion mit L„nge des Strings starten}
 readkey;writeln;
 writeln(anz,' Kombinationen m”glich.');readkey;
end.
{Im Prinzip geht das Programm so vor, daá fr jede Stelle im neuen String
 alle Stellen des Originalstrings der Reihenfolge nach durchgegangen werden.
 Wenn eine Stelle bereits in diesem neuen String vergeben wurde, wird die
 n„chste angenommen usw.
 Beispiel:
 Originalstring: 123
 Program: (-> Korrektur, letzter String je Zeile wird als L”sung ausgegeben)
  11->12 121->122->123
  13 131->132
  21 211->212->213
  22->23 231
  31 311->312
  32 321

 6 M”glichkeiten
}