Задача на перестановки и минимальное число Опции

[1qsd]

В общем, такая задача. Есть какое-то произвольное число (количество цифр <=20). В нем произвольным образом переставляются цифры. Потом находится модуль разности:
abs|число с переставленными числами - обратное к нему|
Таким образом находится много разностей модулей - и надо найти минимальную разность.
Причем, если минимальных разностей несколько, то требуется та, где число с переставленными числами - минимальное.

Вот я задачу вроде решил, но работает она только до количества цифр <=7. А надо, чтобы работала до <=20. Помогите

 Program Gsort;
procedure obr(var a,b:string);
var
 i:longint;
begin
b:='';
for i:=1 to length(a) do b:=a[i]+b;
end;

var
  s,st,str1,Ch1,Ch2: string;
  a: array[0..100] of integer;
  masMIN: array [1..10000] of longint;
  n,i,j,h,k,q,z: integer;
  stCh,str1Ch,MinRaz: longint;

begin
  z:=1;
  masMIN[1]:=0;
  readln(s);
  n := length(s);
  fillchar(a,sizeof(a),0);

  for i:=1 to n do a[i]:=i;

  repeat
    st:='';
    for i:=1 to n do
    begin
    st:=s[a[i]]+st;
    end;

    obr(st,str1);

    write('modul = |',st,' - ',str1,'| = ');

    val(st,stCh,q);
    val(str1,str1Ch,q);

    Ch1:=st;
    masMIN[z]:=abs(stCh-str1Ch);
    writeln(masMIN[z]);
    if z>1 then
    begin
     if masmin[z] < minRaz
        then
        begin
           Ch2:=st;
           MinRaz:=masmin[z];
        end;
     if (Ch2>Ch1) and ((masmin[z] < minRaz) or (masmin[z] = minRaz)) then Ch2:=Ch1;
    end;

    if z=1 then
    begin
      Ch2:=st;
      minRaz:=masMIN[1];
    end;
    inc(z);

    {readln;}

    i := n;
    while a[i-1]>a[i] do dec(i);
    j:=i-1;
    h:=a[j];
    while a[i+1]>h do inc(i);
    a[j]:=a[i];  a[i]:=h;
    i:=j+1; k:=n;
    while i<k do begin
       h:=a[i]; a[i]:=a[k]; a[k]:=h;
       inc(i); dec(k)
    end
  until j=0;

writeln('min raznost ', MinRaz);
writeln('min chislo ', Ch2);
readln;
end.