procedure arrange(n:integer);
var
  num:array[0..n] of integer;
  i,x,y:byte;
begin
  num[0]:=0;
  for i:=1 to n do
  begin
    num[i]:=i;
    write(num[i],' ');
  end;
  writeln;
  repeat
    for i:=1 to n do
      if num[i]>num[i-1] then x:=i;
    for i:=x to n do
      if num[i]>num[x-1] then y:=i;
    if x>1 then
    begin
      swap(num[x-1],num[y]);
      inverse(x);  //对num[x]~num[n]作逆序处理
      for i:=1 to n do write(num[i],' ');  //输出当前序列
      writeln;
    end;
  until x=1;
end;

我的BLOG里有算法，回溯和递归，递归更简单，你去看看
http://hi.baidu.com/649786031/blog