Program lab12;
Uses Crt;
Type  kub = record
dl: string [4];
color:  string [4];
mat: string[4];
end;
  f_st_rec = file of kub;
Var n1,  n2, stroka: string[40];  st: kub;  f1: f_st_rec;  f2: Text;  i, m: integer;  ch: char;
Function FileExists(n1: String): Boolean;
var f1: f_st_rec;
begin
  Assign(f1,n1);
  {$I-}
  reset(f1);
  {$I+}
    if IOResult=0 then begin
      FileExists:=true;
    end
      else fileexists:=false;
end;
Function FileExiststwo(n2: String): Boolean;
var f2: Text;
begin
  Assign(f2,n2);
  {$I-}
  reset(f2);
  {$I+}
  if IOResult=0 then begin
    FileExiststwo:=true;
  end
  else fileexiststwo:=false;
end;
Procedure create(var f1:f_st_rec;var f2: text);
begin
  clrscr;
  assign(f1, '1.dat');
  assign(f2, '2.txt');
  rewrite(f1);
  rewrite(f2);
end;
Procedure transname(var f1:f_st_rec; var f2: text);
begin
  repeat
    clrscr;
    writeln ('1-изменение имени 1-го файла ');
    writeln ('2-изменение имени 2-го файла ');
    writeln ('0-в меню');
      repeat
        write ('ваш выбор:');
        write ('  ');
        readln(m);
      until (m>=0) and (m<=3);
        if m=1 then begin
           writeln('введите имя');
          readln(n1);
          Rename(f2,n2);
        end;
        if m=2 then begin
          close(f2);
          writeln('введите имя');
          readln(n2);
          Rename(f2,n2);
        end;
  until m = 0;
end;
Procedure outputdat(var f1:f_st_rec);
begin
  clrscr;
    if not FileExiststwo(n2) then
      writeln('исходного файла не существует')
    else begin;
  reset(f1);
        writeln('1-белый 2-чёрный 3-розовый 4-оранжевый');
        writeln('1-железо 2-пластик 3-дерево');
    while not eof(f1) do begin
      i:=i+1;
      read(f1,st);
      writeln('кубик №',i,' длина=',st.dl,' цвет=',st.color,' материал',st.mat);
    end;
  close(f1);
  readln;
  end;
End;
Procedure errase(var f1:f_st_rec; var f2: text);
begin
  clrscr;
  repeat
    writeln ('1-удаление первого файла ');
    writeln ('2-удаление второго файла ');
    writeln ('3-в меню');
      repeat
        write ('ваш выбор:');
        write ('  ');
        readln(m);
      until (m>=1) and (m<=4);
        if m=1 then erase(f1);
        if m=2 then erase(f2);
  until m = 3;
end;
Procedure entr (var f1:f_st_rec);
begin
  clrscr;
  rewrite(f1);
  writeln('заполните характеристики кубиков');
    repeat
      with st do begin
        writeln('1-белый 2-чёрный 3-розовый 4-оранжевый');
        writeln('1-железо 2-пластик 3-дерево');
        writeln('длина:   '); readln(dl);
        writeln('цвет :   '); readln(color);
        writeln('материал :'); readln(mat);
      end;
      write(f1, st);
      writeln('Enter -продолжить, Esc - закончить');
      ch:=readkey;
      clrscr;
    until ch=#27;
    close(f1);
end;
Procedure obrab (var f1:f_st_rec; var f2: Text);
var kr,j,z,s,vkr,vj,vz,vs,dk,dz,ds,dj,c,d,dkyb,plastic : integer;
  begin   clrscr;
  kr:=0; j:=0; z:=0; s:=0; vkr:=0; vj:=0; vz:=0; vs:=0; dk:=0; plastic:=0; dkyb:=0;
    reset(f1);
    rewrite(f2);
    writeln( 'Количество кубиков');
      while not(eof(f1)) do begin
        read(f1, st);
          if (st.color='1') then begin
            kr:=kr+1;
            val(st.dl,dk,c);
            vkr:=vkr+dk*dk*dk;
          end;
          if (st.color='2') then begin
            j:=j+1;
            val(st.dl,dj,c);
            vj:=vj+dj*dj*dj;
          end;
          if (st.color='3') then begin
            z:=z+1;
            val(st.dl,dz,c);
            vz:=vz+dz*dz*dz;
          end;
          if (st.color='4') then begin
            s:=s+1;
            val(st.dl,ds,c);
            vs:=vs+ds*ds*ds;
          end;
          val(st.dl,d,c);
          if ((st.mat='2') and (d>2)) then
            plastic:=plastic+1;
      end;
      writeln(f2,'Quantity of the white=', kr,' Volume=', vkr);
      writeln(f2,'Quantity of the black=', j,' Volume=', vj);
      writeln(f2,'Quantity of the pink=', z,' Volume=', vz);
      writeln(f2,'Quantity of the orange=', s,' Volume=', vs);
      writeln(f2,'Quantity of the plastic=', dkyb);
    close(f1);  close(f2); clrscr;
  end;
Procedure outputtxt (var f2:Text);
  begin
    clrscr;
      if not FileExiststwo(n2) then
        writeln('текстового файла не существует')
      else begin;
    reset(f2);
    writeln;
      while not(eof(f2)) do begin
        readln(f2, stroka);
        writeln(stroka);
      end;
    close(f2);
    readln;
  End;
end;
Procedure menu;
  begin
    repeat
    writeln (' Меню:');
    writeln ('1-создание файлов');
    writeln ('2-изменение имён');
    writeln ('3-ввод данных');
    writeln ('4-удаление файлов');
    writeln ('5-обработка данных');
    writeln ('6-просмотр конечного файла ');
    writeln ('7-просмотр исходного файла  ');
    writeln ('8-выход');
      repeat
        write ('ваш выбор:');
        write ('  ');
        readln(m);
      until (m>=1) and (m<=9);
        if m=1 then create(f1,f2);
        if m=2 then transname(f1,f2);
        if m=3 then entr(f1);
        if m=4 then errase(f1,f2);
        if m=5 then obrab(f1,f2);
        if m=6 then outputtxt(f2);
        if m=7 then outputdat(f1);
    until m = 8;
  clrscr;
  end;
Begin
  clrscr;
  n1:='1.dat'; n2:='2.txt';
  assign(f1, n1);
  assign(f2, n2);
  menu;
  writeln('Конец работы');
  readkey;
End.