[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.

lmikle: пользуемся тегами.

[lmikle]

Ну и будет выдавать ошибки.
1. Это чистый паскаль, не delphi. В delphi кое-что поменялось, плюс надо директиву соотв. добавить для создания консольного приложения.
2. Ну, как мне кажется, имплементация слишком сложная. Сначала читаем все, а потом что-то делаем с этим. Тут я бы, как минимум, при чтении сразу бы делил данные на 2 массива - четные или нечетный. Потом отсортировать соотв. образом оба массива, потом записать их в файл.

В общем, как-то так:

Код:

program numbers;

{$APPTYPE CONSOLE}

type
  TIntArray : Array Of Integer;
  
var
  aODD, aEVEN : TIntArray;
  
procedure ReadNumbers(AFileName : String;);
var 
  N : Integer;
  F : TextFile;
begin
  SetLength(aODD,0);
  SetLength(aEVEN,0);
  AssignFile(F, AFileName);
  Reset(F);
  While Not Eof(F) Do
    Begin
      Read(F,N);
      If (N mod 2) = 0
        Then begin SetLength(aEVEN,Length(aEVEN)+1); aEVEN[High(aEVEN)] := N; end
        Else begin SetLength(aODD,Length(aODD)+1); aODD[High(aODD)] := N; end;
    End;
  Close(F);
end;

procedure WriteNumbers(AFileName : String);
var
  F : TextFile;
begin
  AssighFile(F,AFileName);
  Rewrite(F);
  WriteArray(F,aEVEN);
  WriteArray(F,aODD);
  CloseFile(F);
end;

procedure WriteArray(F : TextFile; A : TIntArray);
var
  I : Integer;
begin
  For I := Low(A) To High(A) Do
    WriteLn(F,A[i]);
end;

procedure SortNumbers(var A : TIntArray; IsAsc : Boolean);
var
  I, J : Integer;
  N : Integer;
  F : Boolean;
begin
  For I := Low(A) To High(A)-1 Do
    For J := I+1 To High(A) Do
      Begin
        F := A[i] > A[J];
        If Not IsAsc Then F := Not F;
        
        If F Then
          Begin
            N := A[i];
            A[i] := A[J];
            A[J] := N;
          End;
      End;
end;

begin
  ReadNumbers('C:\Users\User\Desktop\f1.txt');
  SortNumbers(aEVEN,True);
  SortNumbers(aODD,False);
  WriteNumbers('C:\Users\User\Desktop\f2.txt');
end.

ЗЫ. Не проверял. Может потребуется что-нить поправить слегка.
ЗЗЫ. Для особо умных. Да. можно было сразу сделать сортировку вставкой, но это бы существенно усложнило бы понимание кода. И так совместил процедуры сортировки. Так же можно было бы сделать класс для храниения, клас-ридер для чтения и вообще накрутить кучу всего. Но для школьного задания это излишне.