рекурсия

program recursion;
        uses crt;
        var st:string[32];
            original:string[32];
            chst:array[1..32] of char;
            i,k:byte;

procedure blend(abc:string);
begin
     for i:=1 to length(st) do
         chst:=st;
     for i:=1 to length(st)-1 do begin
         insert(chst[i+1],st,i);
         delete(st,i+2,1);
         writeln(st);
     end;
     while original<>st do blend(st);
end;

begin
     clrscr;
     writeln('Vvedite stroku: '); readln(st); writeln;

     original:=st;
     blend(st);
     readkey;
end.

//сортирует строку методом пузырька
procedure SortLine(var Line: string);
  var i,i1: integer;
      tmp: char;
      WasSwap: boolean;
  begin
    repeat
      WasSwap:=false;
      for i:=2 to Length(Line) do begin
          i1:=i-1;
          if Line < Line[i1] then begin
              tmp:=Line;
              Line:=Line[i1];
              Line[i1]:=tmp;
              WasSwap:=true
          end;
      end;
    until not WasSwap;
  end;

//пихает куданить новую строку
procedure PutLine(const Line: string);
  begin
//    Form1.Memo1.Lines.Add(Line)
  end;

//собственно алгоритм
procedure Blend(Line: string);
  var LineLen: integer;
      Taken: array of boolean;

      procedure _Blend(Deep: integer; Ind: integer; const Str: string);
        var i: integer;
        begin
          Taken[Ind]:=true;
          if Deep = LineLen then begin
              PutLine(Str);
          end else begin
              for i:=1 to LineLen do begin
                  if not Taken then begin
                      _Blend(Deep+1,i,Str+Line);
                  end;
              end;
          end;
          Taken[Ind]:=false;
        end;

  begin
    LineLen:=Length(Line);
    SortLine(Line);
    SetLength(Taken,LineLen+1);
    _Blend(0,0,'');
  end;