求救！帮忙实现一个算法！

function ZsList(mStr: string): string; { 全排列 }  procedure pZsList(mLeft, mRight: string);
  var
    I, L: Integer;
    Temp: string;
  begin
    L := Length(mLeft);
    if L = 0 then
      Result := Result + mRight + #13#10
    else for I := 1 to L do begin
      Temp := mLeft;
      Delete(Temp, I, 1);
      pZsList(Temp, Concat(mRight, mLeft[I]));
    end;
  end; { [ZsList<pZsList>] }begin
  Result := '';
  pZsList(mStr, '');
end; { ZsList }function Power(Base, Exponent: Integer): Integer;
var
  I: Integer;
begin
  Result := 1;
  for I := 1 to Exponent do
    Result := Result * Base;
end; { Power }const
  cScaleChar = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';function IntToDigit(mScale: Byte; mInt: Integer; mLen: Integer): string;
var
  I, J: Integer;
begin
  Result := '';
  I := mInt;
  while (I >= mScale) do begin
    J := I mod mScale;
    Result := Copy(cScaleChar, Succ(J), 1) + Result;
    I := I div mScale;
  end;
  Result := Copy(cScaleChar, Succ(I), 1) + Result;
  if mLen > 0 then
    for I := Length(Result) to mLen - 1 do
      Result := '0' + Result;
end; { IntToDigit }procedure TForm1.Button1Click(Sender: TObject);
var
  I, J, L: Integer;
  S, T, P: string;
begin
  L := Length(Edit1.Text);
  for I := 1 to Power(2, L) - 1 do begin
    T := IntToDigit(2, I, L);
    P := '';
    for J := 1 to Length(T) do
      if T[J] = '1' then P := P + Edit1.Text[J];
    S := S + ZsList(P);
  end;
  with TStringList.Create do try
    Text := S;
    for I := 0 to Count - 2 do
      for J := Count - 1 downto I + 1 do
        if (Length(Strings[I]) > Length(Strings[J])) or
           ((Length(Strings[I]) = Length(Strings[J])) and
            (Strings[I] > Strings[J])) then
          Move(I, J);
    Edit2.Text := StringReplace(Trim(Text), #13#10, ',', [rfReplaceAll]);
  finally
    Free;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '1234';
end;