Дана строка, состоящая из М символов. Вывести все перестановки символов данной строки

const
 alphabet : string[8] = 'ABCDEFGH';
 type
 barray = array [1..100] of byte;
 var
 b : barray;
 N,M,i,j,k : byte;
 z : longint;
 Procedure WriteB(B:barray);
 begin
 Inc(Z); Write (Z:3,' : ');
 for i:=1 to M do write(alphabet[b[i]]);
 writeln;
 end;
 Procedure SwapB(var B:barray;i,k:byte);
 var x : byte;
 begin
 x:=B[i]; B[i]:=B[k]; B[k]:=x;
 end;
 Procedure PermuteAll(B:barray;N:byte);
 var i,k,j : byte;
 begin
 WriteB(B);
 while (true) do
 begin
 i:=N;
 while (i>0) and (B[i]>=B[i+1]) do i:=i-1;
 if i=0 then exit;
 for j:=i+1 to N do
 if (B[j]>B[i]) then K:=j;
 SwapB(B,i,k);
 for j:=i+1 to (i+ ((N+1-i) div 2)) do SwapB(B,j,N+i+1-j);
 WriteB(B);
 end;
 end;
 begin
 readln(N,M);
 for i:=1 to M do b[i]:=i;
 PermuteAll(B,M);
 while (true) do
 begin
 i:=M;
 while (i>0) and (b[i]=N-m+i) do Dec(i);
 if i=0 then exit;
 Inc(B[i]);
 for j:=i+1 to M do B[j]:=B[j-1]+1;
 PermuteAll(B,M);
 end;
 readln;
 end.

var
  a: array[0 .. 20] of char;
    n: integer ;
procedure print(T: integer);
var i: integer;
begin
  for i := 1 to T do write(a[i]:3);
  writeln
end;
 
procedure swap(var a, b: char);
var T: char;
begin T := a; a := b; b := T end;
 
procedure solve(T: integer);
var i: integer;
begin
  if T >= n then print(t)
  else
    for i := T + 1 to n do begin
      swap(a[T+1], a[i]);
      solve(T+1);
      swap(a[t+1], a[i])
    end
end;
 
var
  i: integer;
  s: string;
 
begin
  readln(s);
  n := length(s);
 
  for i := 1 to n do a[i] := s[i];
  solve(0)
end.

 var a, b: array[1..255] of integer; 
 s:string;
 len, i:integer;
 procedure rec(t:integer);
 var i:integer;
 begin
 if t>len then begin
  for i:=1 to len do write(chr(b[i]));
  writeln();
  Exit;
 end;
 for i:=1 to 255 do
  if a[i]>0 then begin
  b[t]:=i;
  dec(a[i]);
  rec(t+1);
  inc(a[i]);  
  end;
 end;
 
 begin
 writeln('Введите строку');
 read(s);
 len:=Length(s);
 for i:=1 to len do
 inc(a[ord(s[i])]);
 rec(1); 
 end.

type str8 = string[8];
 
procedure Permute(const t,s: str8);
var
  i,j: integer;
  lenS : byte;
  ch : char;
begin
  lenS := length(s);
  if lenS=0 then
    writeln(t)
  else
    for i:=1 to lenS do begin
      ch := s[i];
      j:=1;
      while s[j]<>ch do inc(j);
      if j=i then
        Permute(t+ch, Copy(s,1,i-1)+Copy(s,i+1,Length(s)-i))
    end;
end;
 
 
var
  s    : str8;
  ch   : char;
  i, j : integer;
 
begin
    readln(s);
 
  { отсортируем символы в строке: }
  for i := 1 to length(s) - 1 do begin
      for j := i + 1 to length(s) do
        if s[j] < s[i] then begin
          ch := s[i];
          s[i] := s[j];
          s[j] := ch;
        end;
    end;
 
  Permute('',s);
end.