Создать текстовый файл с исходными данными любой размерности. Из текстового файла переписать числа в массив, типизированный файл. Сделать контрольный

uses crt;
const nmax=100;
var a:array[1..nmax] of integer;
    n,i,j,k:byte;
    x:integer;
begin
clrscr;
randomize;
repeat
write('Размер массива до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Массив:');
for i:=1 to n do
 begin
  repeat
  a[i]:=random(10)-5;
  until a[i]<>0;
  write(a[i]:4);
 end;
writeln;
writeln;
k:=0;
for i:=n downto 1 do
if a[i]>0 then
  begin
    k:=k+1;
    x:=a[i];
    for j:=i to n-k do
    a[j]:=a[j+1];
    a[n-k+1]:=x;
  end;
writeln('Перестановка:');
for i:=1 to n do
write(a[i]:4);
writeln;
writeln;
for i:=2 to n do
if a[i]*a[i-1]<0 then
 begin
  a[i]:=0;
  a[i-1]:=0;
 end;
writeln('Замена на 0:');
for i:=1 to n do
write(a[i]:4);
readln
end.

uses crt;
var f:file of integer;
    n,i,j,p:integer;
    a,c,d,x:integer;
    k:byte;
begin
clrscr;
assign(f,'file1');
rewrite(f);
writeln('Введите в файл целые положительные и отрицательные чичла, окончание ввода 0');
repeat
readln(c);
if c<>0 then write(f,c);
until c=0;
reset(f);
writeln('Содержание исходного файла:');
while not eof(f) do
 begin
  read(f,c);
  write(c,' ');
 end;
writeln;
close(f);
{перестановка отрицательных вперед}
reset(f);
p:=0;
for i:=0 to filesize(f)-1 do
 begin
  seek(f,i);
  read(f,c);
  if c<0 then{если отрицательное}
   begin
    p:=p+1;{считаем}
    x:=c;{запоминаем}
    for j:=i downto p do{идем назад}
     begin
      seek(f,j-1);{читаем предыдущее число }
      read(f,d);
      seek(f,j);{вставляем вперед}
      write(f,d);
     end;
    seek(f,p-1);{вставляем на место которое нашли}
    write(f,x);
   end
 end;
if (p=0)or(p=filesize(f)) then
  begin
   write('Перестановок не было!');
   close(f);
  end
else
 begin
  writeln('Содержание нового файла:');
  reset(f);
  while not eof(f) do
   begin
    read(f,c);
    write(c,' ');
   end;
  close(f);
{замена граничных нолями}
  reset(f);
  for i:=0 to filesize(f)-1 do
   begin
    read(f,c);
    if c>0 then
     begin
      p:=i;
      break;
     end;
    a:=0;
    seek(f,p);
    write(f,a);
    seek(f,p-1);
    write(f,a);
   end;
  close(f);
  writeln('Замена граничных элементов на 0:');
  reset(f);
  while not eof(f) do
   begin
    read(f,c);
    write(c,' ');
   end;
  close(f);
 end;
readln
end.

uses crt;
const nmax=100;
      tname='text.txt';
      fname='tfile.dat';
type mas=array[1..nmax] of integer;
     fail=file of integer;
var bt,bm,bf:boolean;
procedure TextFile(var f:text);
var n,a,i:integer;
begin
rewrite(f);
repeat
write('Количество чисел до ',nmax,' n=');
readln(n);
until n in [1..nmax];
for i:=1 to n do
 begin
  repeat
  a:=random(10)-5;
  until a<>0;
  write(f,' ',a);
 end;
bt:=true;
close(f);
end;
procedure Massiv(var f:text;var v:mas;var n:byte);
var a:integer;
begin
if bt=false then
 begin
  writeln('Текстовый файл с данными не создан, вернитесь к пункту 1');
  readln;
  exit;
 end;
reset(f);
writeln('Исходный массив:');
n:=0;
while not eof(f) do
 begin
  n:=n+1;
  read(f,v[n]);
  write(v[n]:4);
 end;
readln;
close(f);
bm:=true;
end;
procedure PersMas(var v:mas;n:byte);
var i,k,j:byte;
    x:integer;
begin
if bm=false then
 begin
  writeln('Массив еще не создан, вернитесь к пункту 2');
  readln;
  exit;
 end;
k:=0;
for i:=n downto 1 do
if v[i]>0 then
  begin
    k:=k+1;
    x:=v[i];
    for j:=i to n-k do
    v[j]:=v[j+1];
    v[n-k+1]:=x;
  end;
writeln('Перестановка:');
for i:=1 to n do
write(v[i]:4);
writeln;
writeln;
for i:=2 to n do
if v[i]*v[i-1]<0 then
 begin
  v[i]:=0;
  v[i-1]:=0;
 end;
writeln('Замена на 0:');
for i:=1 to n do
write(v[i]:4);
readln
end;
procedure TFile(var f:text;var g:fail);
var a:integer;
begin
if bt=false then
 begin
  writeln('Текстовый файл с данными не создан, вернитесь к пункту 1');
  readln;
  exit;
 end;
reset(f);
rewrite(g);
writeln('Содержание исходного файла:');
while not eof(f) do
 begin
  read(f,a);
  write(g,a);
  write(a:4);
 end;
readln;
close(f);
close(g);
bf:=true;
end;
procedure PersFail(var g:fail);
var i,j,p:byte;
    a,c,d,x:integer;
begin
if bf=false then
 begin
  writeln('Типизированный файл еще не создан, вернитесь к пункту 4');
  readln;
  exit;
 end;
reset(g);
p:=0;
for i:=0 to filesize(g)-1 do
 begin
  seek(g,i);
  read(g,c);
  if c<0 then
   begin
    p:=p+1;
    x:=c;
    for j:=i downto p do
     begin
      seek(g,j-1);
      read(g,d);
      seek(g,j);
      write(g,d);
     end;
    seek(g,p-1);
    write(g,x);
   end
 end;
if (p=0)or(p=filesize(g)) then
  begin
   write('Перестановок не было!');
   close(g);
  end
else
 begin
  writeln('Перестановка:');
  reset(g);
  while not eof(g) do
   begin
    read(g,c);
    write(c,' ');
   end;
  close(g);
  reset(g);
  for i:=0 to filesize(g)-1 do
   begin
    read(g,c);
    if c>0 then
     begin
      p:=i;
      break;
     end;
    a:=0;
    seek(g,p);
    write(g,a);
    seek(g,p-1);
    write(g,a);
   end;
  close(g);
  writeln;
  writeln('Замена граничных элементов на 0:');
  reset(g);
  while not eof(g) do
   begin
    read(g,c);
    write(c,' ');
   end;
  close(g);
 end;
readln;
end;
var f:text;
    g:fail;
    a:mas;
    n:byte;
    w:char;
begin
clrscr;
randomize;
bt:=false;
bm:=false;
bf:=false;
assign(f,tname);
assign(g,fname);
repeat
clrscr;
writeln('Выберите действие');
writeln('1-создание нового текстового файла');
writeln('2-создание массива');
writeln('3-преобразование массива');
writeln('4-создание типизированного файла');
writeln('5-преобразование типизированного файла');
writeln('другое - выход');
readln(w);
case w of
'1':TextFile(f);
'2':Massiv(f,a,n);
'3':PersMas(a,n);
'4':TFile(f,g);
'5':PersFail(g);
else exit;
end;
until not(w in ['1'..'5']);
end.