function Factorial(n: integer): string;
const len = $2000;
var i, j, k, z, um: integer;
    p, p1: array[0..len-1] of byte;
begin
   for i:=1 to len-1 do
      p[i]:=0;
   p[0]:=1;
   for i:=1 to n do
   begin
      for j:=0 to len-1 do
         p1[j]:=0;
      z:=i;
      k:=0;
      repeat
         um:=0;
         for j:=0 to len-1 do
         begin
            if j+k>=len then
               Continue;
            p1[j+k]:=p1[j+k]+um+p[j]*(z mod 10);
            um:=p1[j+k] div 10;
            p1[j+k]:=p1[j+k] mod 10;
         end;
         Inc(k);
         z:=z div 10;
      until z=0;
      for j:=0 to len-1 do
         p[j]:=p1[j];
   end;
   Result:='';
   for i:=0 to len-1 do
      Result:=IntToStr(p[i])+Result;
   while (Result<>'') and (Result[1]='0') do
      Delete(Result, 1, 1);
end;