Длинная арифметика. Факториал

{$R+}
program my10_5;
uses crt;
const maxn = 300;
var a: array [0..maxn] of longint;
    n: longint;
    i,j,r,w: longint;
begin clrscr;
  fillchar(a,sizeof(a),0);
  write('Введите число N, факториал которого нужно подсчитать --> ');
  readln(n);
  a[0] := 1; a[1] := 1; j := 2;
  while (j <= n) and (a[0] < maxn) do
    begin
      r := 0; i := 1;
      while (i <= a[0]) or (r <> 0) do
        begin
          w := a[i]*j+r;
          a[i] := w mod 10;
          r := w div 10;
          if [U]a[a[0]+1] <> 0[/U] then inc(a[0]);
          inc(i);
        end;
      inc(j);
    end;
  write(n,'! = ');
  for i := a[0] downto 1 do write(a[i]);
  readln;
end.

const
  { Искать факториал для чисел не больше 7000 }
  LongLength = 25000; { В числе 7000! цифр будет не больше }
 
var
  LongLen : Word;
  Long : array [0..LongLength] of Byte;
  N, LongN, i : Word;
  D : Word;
begin
  Write('N = '); ReadLn(N);
  
  { Сюда бы по идее вставить обработчик правильности ввода числа не больше 7000 }
  
  LongN   := 1; { В массиве хранится факториал числа }
  LongLen := 0; { Длина массива }
  Long[0] := 1; { Данные массива }
  
  while LongN < N do { Пока не получен факториал искомого числа }
    begin
      Inc(LongN); { Сейчас получим факториал для числа }
      
      { Умножение Long на LongN }
      D := 0;
      for i := 0 to LongLen do
        begin
          D := D + LongN * Long[i]; { Приведение типов к Word }
          (* Нужно быть уверенным, что D+7000*9 не больше 65535. *)
          
          Long[i] := D mod 10;
          D := D div 10;
        end;
        
      { Перенос десятичных значений скинем в Long }
      while D > 0 do
        begin
          Inc(LongLen);
          if LongLen > LongLength then { Переполнение }
            begin
              WriteLn('Произошло переполнение при нахождении ', LongN, '!');
              Halt(-1);
            end;
            
          Long[LongLen] := D mod 10;
          D := D div 10;
        end;
    end;
  
  Write(N, '! = '); for i := LongLen downto 0 do Write(Long[i]); WriteLn;
  WriteLn('Длина числа = ', LongLen);
  i := 0; while Long[i] = 0 do Inc(i);
  WriteLn('Число нолей в конце числа = ', i);
end.