Считать массив чисел из файла и записать в другой файл два массива (Pascal ABC)

[Luka_Megurine]

Добрый день. Помогите, пожалуйста, написать программу.
В строках текстового файла содержатся целые числа. Преобразовать строки файла следующим образом: вначале должны идти четные числа, упорядоченные по возрастанию, а затем нечетные, упорядоченные по убыванию. Их надо записать в другой файл.
Есть программа, но она выдаёт мне ошибки.

program files;

type
  mas = array[1..100] of integer;

var
  f1, f2: text; 
  a, b, d: mas; 
  k, p, i, j: integer;

procedure Readfile(f1: text; var a: mas; var k: integer);
begin
  p := 0; 
  k := 0; 
  while not eof(f1) do 
  begin
    readln(f1, a[k]); 
    k := k + 1; 
  end; 
end;

procedure Check(var a: mas; p: integer);
var
  k, i, j: integer;
  b, d: mas;
begin
  i := 1; 
  j := 1; 
  for k := 1 to p do 
  begin
    if (a[k] mod 2 = 0) then 
    begin
      b[i] := a[k]; 
      i := i + 1; 
    end 
    else 
    begin
      d[j] := a[k]; 
      j := j + 1; 
    end; 
  end; 
end;

procedure Regularise(var b, d: mas; var i, j: integer; f2: text);
var
  H, Y: integer;
begin
  assign(f2, 'C:\Users\User\Desktop\f2.txt'); 
  rewrite(f2); 
  H := 0; 
  Y := 0; 
  while i <> High(b) + 1 do 
  begin
    if b[i] > b[i + 1] then 
    begin
      H := b[i]; 
      b[i] := b[i + 1]; 
      b[i + 1] := H; 
      readln(f2, b[i]); 
    end; 
  end; 
  while j <> High(d) + 1 do 
  begin
    if d[j] < d[j + 1] then 
    begin
      Y := d[j]; 
      d[j] := d[j + 1]; 
      d[j + 1] := Y; 
      readln(f2, d[j]); 
    end; 
  end; 
  close(f2); 
end;

begin
  assign(f1, 'C:\Users\User\Desktop\f1.txt'); 
  reset(f1); 
  Readfile(f1, a, k); 
  Check(a, p); 
  assign(f2, 'C:\Users\User\Desktop\f2.txt'); 
  rewrite(f2); 
  Regularise(b, d, i, j, f2); 
  closefile(f1); 
  closefile(f2); 
end.

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор