[Pascal]Удалить из последовательности числа... продублировать числа...

[suigintou]

Помогите отладить программу, в ПаскальАБЦ все работает, но на других IDE типа фри паскаля появляется 201 ошибка (выход за границы массива или обращение к несуществующему элементу).

Дана последовательность натуральных чисел {Aj}j=1...n (n<=10000). Удалить из последовательности числа, все цифры которых различны, а среди оставшихся продублировать числа, произведение которых кратно 14.

При запуске на онлайн-компиляторе вообще работает не так как на ПаскальАБЦ. http://ideone.com/LAxTYY

  program main;
  
  type TByte=array[0..9] of Byte;
  type TArray=array[1..10000] of Integer;
  
  {Заполняет массив значениями value}
  procedure FillArray(A:TByte; size:Integer; value:Integer);
  var i:Integer;
  begin
    for i:=1 to size do
      A[i]:=value;
  end;
  
  function product(a:Integer):Integer;
   var p:LongInt;
   begin
    p:=1;
    while a>0 do begin
      p:=p*(a mod 10);
      a:=a div 10;
    end;
    product:=p;
  end;
  {Тестирует число по условию задачи.
  0 - все цифры разные (удалить число), 1 - есть одинаковые (пропустить), 
  2 - дублировать. Каждый элемент массива index[0..9] содержит количество 
  соответствующих цифр в числе, например index[3]=5 - в числе пять троек}
  function TestNumber(n:Integer):Integer;
  var index:TByte;
      status:Byte;
      i,a:Integer;
  begin
    status:=0;
    TestNumber:=status;
    FillArray(index,High(index)-Low(index),0);
    a:=n; {Сохраним значение n}
    while n>0 do
      begin
        inc(index[n mod 10]);
        n:=n div 10;
      end;
    for i:=0 to 9 do
      if index[i]>1 then
        begin
          status:=1; {Есть повторяющиеся цифры}
          TestNumber:=status;
          break;
        end;
    if (status=0) then exit;
    if (product(a) mod 14)=0 then
      TestNumber:=2;
  end;
  
  {Удаление числа из массива}
  procedure delete(var A:TArray; var n:Integer);
  var k,m:Integer;
  begin
    k:=1;
    while k<=n do
      if TestNumber(A[k])=0 then
        begin
          for m:=k to n-1 do
            A[m]:=A[m+1];
          n:=n-1;
        end
       else
        k:=k+1;
  end;
  
  procedure DreadMagic(var A:TArray; var B:TArray; var n:Integer);
  var k,i:Integer;
  begin
    k:=0;
    for i:=1 to n do
    case TestNumber(A[i]) of
      0: ; {do nothing}
      1: begin
            k:=k+1;
            B[k]:=A[i];
         end;
      2: begin
            k:=k+1; B[k]:=A[i];
            k:=k+1; B[k]:=A[i];
         end;
    end;
    n:=k;
  end;
  
  procedure Input(var A:TArray; var n:Integer);
  var i:Integer;
  begin
    write('Enter n: ');
    read(n);
    writeln('Enter ',n, ' elements:');
    for i:=1 to n do
      read(A[i]);
  end;
  
  procedure Output(A:TArray; n:Integer);
  var i:Integer;
  begin
    for i:=1 to n do
      write(A[i]:6);
  end;
  
  const T:array[1..7] of Integer=(987,4562,1123,31234,32368,876,1172);
  var A:TArray;
      B:TArray;
      i,n:Integer;
  begin
    n:=7;
    for i:=1 to n do begin
      A[i]:=T[i];
    end;
    {Input(A,n);}
    DreadMagic(A,B,n);
    Output(B,n);
  end.