Постоянная Капрекара (Delphi)

[ДрАгОцЕнНоСтЬ]

нужно составить программу для вычисления циклов всех 4-х разрядных чисел.(берется четырехзначное число, в котором не все цифры одинаковы. Распологаются цифры сначала в порядке возрастания, а потом в порядке убывания, а затем вычитается из первого второе. Повторяя тот же процесс с разностями) результаты сохранять в файл.
пожалуйста помогите! срочно нужно!

[Mad_Cat]

const cc=6174;
var count:integer;
f:textfile;
function AllOne(N:integer):boolean;
var f:boolean;
var k:integer;
begin
  allone:=true;
  for k:=1 to 9 do
  if abs(n/k -1111)<=0.00001 then exit;
  allone:=false;
end;

function Up(N:integer):integer;
var a:array[1..4] of integer;
   i,j:integer;
    d:integer;
    res:integer;
begin
d:=1;i:=1;  for i:=1 to 4 do a[i]:=0;
for i:=1 to 4 do
begin
a[i]:=n mod 10;
n:=n div 10;
end;
   for j:=1 to 3 do
     for i:=1 to 4-j do
        if a[i] > a[i+1] then
     begin
     a[i]:=a[i+1]+a[i];
     a[i+1] :=a[i]-a[i+1];
     a[i] :=a[i]-a[i+1];
     end;
     res:=0;
for i:=1 to 4 do begin
res:=res+a[i]*d;
d:=d*10;
end;
 up:=res;
end;
function Down(N:integer):integer;
var a:array[1..4] of integer;
   i,j:integer;
    d:integer;
    res:integer;
begin
for i:=1 to 4 do a[i]:=0;
d:=1;
for i:=1 to 4 do
begin
a[i]:=n mod 10;
n:=n div 10;
end;
   for j:=1 to 3 do
     for i:=1 to 4-j do
        if a[i] < a[i+1] then
     begin
     a[i]:=a[i+1]+a[i];
     a[i+1] :=a[i]-a[i+1];
     a[i] :=a[i]-a[i+1];
     end;
     res:=0;
for i:=1 to 4 do begin
res:=res+a[i]*d;
d:=d*10;
end;
 down:=res;
end;
procedure constK(N:integer);
var max,min,razn :integer;
begin
max:=up(N);
min:=down(N);
razn:=max-min;
write(f,n,':');
while razn<>cc do begin
write(f,max,'-',min,'=',razn,'--->');
max:=up(razn);
min:=down(razn);
razn:=max-min;
end;
writeln(f,max,'-',min,'=',razn);
end;
begin
assignfile(f,'c:\result.txt');
rewrite(f);
for count:=1000 to 9998 do
if not allone(count) then
constK(count);
closefile(f);
end.