{*************************************************}
{* (c) 1996 by Yucon (Boris Sachsenberg)         *}
{* Compiler: Borland Pascal 7.0/Turbo-Pascal 7.0 *}
{*************************************************}
{$X+}                         {Extended Syntax wg. Readkey ohne Rckgabewert}
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 fr repeat until}
    end;
   end;
  until z>0;     {Bei Schleifenabbruch, nochmalige šberprfung d. neuen Pos.}
  wortx[length(wort)-l+1]:=chr(y);   {Positon des entspr. Zeichens speichern}
  if l>1 then pch(l-1);                {Recursiver Aufruf fr 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á fr 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
}