Создать файл "сведения о кубиках"

 { создаем файл записей про кубики }
 uses crt;
 
 Type Kubik = record
        DlinaR  : integer;
        Cvet    : string;
        Materija: string;
      end;
      
 var
 f:file of Kubik;
 s: Kubik;
 i,n:integer;
 
 begin
 assign(f,'in.dat');
 rewrite(f);
 Write('Введите кол-во кубиков: '); readln(n);
 For i:=1 to n do
   begin
   write('Длина ребра ',i,'-го кубика: ');   readln(s.dlinaR);
   write('Цвет кубика: ');                   readln(s.cvet);
   write('Материал: ');                      readln(s.Materija);
   writeln;
   Write(f,s);
   end;
 close(f);
 end.

 { открываем созданный ранее файл и ищем кубики }
 uses crt;
 
 Type Kubik = record
        DlinaR  : integer;
        Cvet    : string;
        Materija: string;
      end;
 
 var
 f:file of Kubik;
 s: Kubik;
 i,x,y,n:integer;
 
 begin
 assign(f,'in.dat');
 reset(f);
 while not eof(f) do
 begin
 read(f,s);
 If (s.Materija = 'Деревянный')   and (s.DlinaR = 3)   then inc(x);
 If (s.Materija = 'Металический') and (s.DlinaR > 5) then inc(y);
 end;
 If x>0 then writeln('Кол-во деревянных кубиков с длиной ребра 3см - ',x) else writeln('Нету деревянных кубиков с длиной ребра 3см');
 If y>0 then writeln('Кол-во металических кубиков с длиной более 5см - ',y) else writeln('Нету металических кубиков с длиной более 5см');
 close(f);
 end.

program NewBase;
uses crt;
type 
pupil=record
name:string[10];
surname:string[10];
Classnumber:integer;
letter:string[1];
kol:integer;
end;
var
base:file of pupil;
y4:pupil;
FileName:string;
i,n:integer;
Begin
writeln('Введите название базы учеников');
readln(FileName);
Assign(base,FileName);
Rewrite(base);
writeln('Введите кол-во учеников в базе данных');
readln(n);
Writeln('Приступим к вводу даных об учениках');
with y4 do
kol:=n;
 
for i:=1 to n do 
begin
with y4 do
begin
 
 write('Фамилия ученика: ');
 readln(surname);
 write('Имя: ');
 readln(name);
 write('Номер класса: ');
 readln(classnumber);
 write('буква класса: ');
 readln(letter);
 end;
 write(base,y4);
 end;
 close(base);
 writeln('Конец ввода даных. Нажмите ENTER');
 readkey;
 end.

program kubi;
uses crt;
type 
kub=record
color:string[10];
material:string[10];
razmer:integer;
 
end;
var
base:file of kub;
a:kub;
FileName:string;
i,n:integer;
c:char;
Begin
writeln('Введите название базы Кубиков');
readln(FileName);
Assign(base,FileName);
Rewrite(base);
writeln('Введите кол-во кубиков вводимых в базу данных');
readln(n);
Writeln('Приступим к вводу даных о кубиках');
with a do
 
 
for i:=1 to n do 
begin
with a do
begin
 
 writeln('Введите цвет:');
 writeln('1=красный');
 writeln('2=Желтый');
 writeln('3=Зеленый');
 writeln('4=Синий');
 readln(c);
 case c of
 '1':color:='Красный';
 '2':color:='Желтый';
 '3':color:='Зеленый';
 '4':color:='Синий';
 end;
 writeln('Введите материал');
 writeln('1=Деревянный');
 writeln('2=Металлический');
 writeln('3=Картонный');
 
 readln(c);
 case c of
 '1':material:='Деревянный';
 '2':material:='Металлический';
 '3':material:='Картонный';
 
 end;
 
  write('Введите размер: ');
 readln(razmer);
 end;
 write(base,a);
 end;
 close(base);
 writeln('Конец ввода даных. Нажмите ENTER');
 readkey;
 end.

type 
kub=record
color:string[10];
material:string[10];
razmer:integer;
 
end;
var
g: file of kub;
a:kub;
ob:integer;
s,i:real;
 
 
begin
assign (g,'kub');
reset(g);
while eof(g)=false do begin
Read(g,a);
 
if a.color=a.color then begin
ob:=(a.razmer*a.razmer*a.razmer);
s:=(ob+ob);
s:=s/2;
i:=i+1;
end;
 
writeln('суммарный обьем кубиков данного цвета (',a.color,') = ',s,' и их кол-во= ',i);
end;
 
close(g);
end.

 program NewBase;
 
 uses crt;
 
 type
      pupil=record
          name:string[10];
          surname:string[10];
          Classnumber:integer;
          letter:string[1];
          kol:integer;
      end;
      
 var
 base,g:file of pupil;
 y4:pupil;
 FileName:string;
 i,j,n:integer;
 
 Begin
 writeln('Введите название базы учеников');
 readln(FileName);
 Assign(base,FileName);
 assign(g,'svedenija.dat');
 reset(base);
 rewrite(g);
 For i:=9 to 10 do
    For j:=224 to 231 do
    begin
       While not eof(base) do
       begin
       read(base,y4);
       If (y4.Classnumber = i) and (y4.letter = chr(j)) then write(g,y4);
       end;
    seek(base,0);
    end;
 close(base);
 close(g);
 readkey;
 end.

program NewBase;
 
 uses crt;
 
 type
      pupil=record
          name:string[10];
          surname:string[10];
          Classnumber:integer;
          letter:string[1];
          kol:integer;
      end;
 
 var
 base,g:file of pupil;
 y4:pupil;
 FileName:string;
 i,j,n:integer;
 
 Begin
 assign(g,'svedenija.dat');
 reset(g);
 While not eof(g) do
 begin
 read(g,y4);
 writeln(y4.Classnumber,'    ',y4.letter);
 end;
 close(g);
 readkey;
 end.

uses crt;
 
type ucheniki = record;
     name: string[10];
     fam:  string[10];
     kl:   integer;
     kll:  string[1];
     oz: array [1..20] of integer;
     end;
 
var u:array [1..100] of ucheniki;
    srsum: array [1..11] of real;
    i,j,k,n,m,sum,ku,r:integer;
    f,g: file of ucheniki;
    
begin
assign(f, 'C:\uch.dat');
assign(g, 'C:\luch.dat');
rewrite(f);
write('Сколько учеников? ');
readln(n);
write('Сколько отметок у одного ученика? ');
readln(m);
writeln('Внесите данные об учениках: ');
for i:=1 to n do
    with u[i] do
         begin
         write('Фамилия ',i,' учащегося: '); readln(fam);
         write('Имя: '); readln(name);
         write('Класс(цифра): '); readln(kl);
         write('Класс(буква): '); readln(kll);
         writeln('Oценки, всего ',m,': ');
         for j:=1 to m do readln(oz[j]);
         write(f,u[i]);
         end;
reset(f);
rewrite(g);
while not eof(f) do
      read(f,u[i]);
for k:=1 to 11 do
    begin
    sum:=0;
    for i:=1 to n do
        if u[i].kl=k then
           for j:=1 to m do
               begin
               inc(sum,u[i].oz[j]);
               inc(ku);
               end;
    if ku>0 then srsum[k]:=sum/ku else srsum[k]:=0;
    end;
writeln('Лучшие учащиеся: ');
for i:=1 to n do
    begin
    sum:=0; k:=0;
    with u[i] do
         begin
         for j:=1 to m do
             begin
             inc(sum,u[i].oz[j]);
             if u[i].oz[j]<4 then inc(k);
             end;
         if (k=0) and (sum>=srsum[u[i].kl]) then
            begin
            writeln(u[i].fam:11,u[i].name:11,u[i].kl:3,u[i].kll);
            write(g,u[i]);
            end;
         end;
    end;
writeln('Данные о лучших учениках занесены в файл 2 ');
writeln('Нажмите 1, чтобы просмотреть содержимое файла 2 (сокращенно)');
readln(r);
if r=1 then
   begin
   reset(g);
   while not eof(g) do
         begin
         read(g,u[i]);
         writeln(u[i].fam:11,u[i].name:11,u[i].kl:3,u[i].kll);
         end;
   end;
close (f);
close (g);
end.

 uses crt;
 
 Type Kubik = record
        DlinaR  : integer;
        Cvet    : string;
        Materija: string;
      end;
 
 var
 f:file of Kubik;
 s: Kubik;
 i,n,c:integer;
 
 begin
 assign(f,'C:\in.dat');
 rewrite(f);
 Write('Введите кол-во кубиков: '); readln(n);
 For i:=1 to n do
   begin
   write('Длина ребра ',i,'-го кубика: ');   readln(s.dlinaR);
   write('Цвет кубика: 1-красный, 2-желтый, 3-зеленый, 4-синий ');
   readln(c);
   case c of
   1: s.cvet:='красный';
   2: s.cvet:='желтый';
   3: s.cvet:='зеленый';
   4: s.cvet:='синий';
   end;
   write('Материал: 1-дерево, 2-металл, 3-картон ');
   readln(c);
   case c of
   1: s.Materija:='дерево';
   2: s.Materija:='металл';
   3: s.Materija:='картон';
   end;
   writeln;
   Write(f,s);
   end;
 close(f);
 end.

 uses crt;
 
 Type Kubik = record
        DlinaR  : integer;
        Cvet    : string;
        Materija: string;
      end;
 
 var
 f:file of Kubik;
 s: Kubik;
 n:integer;
 sobR,sobY,sobG,sobB:real;
 
 begin
 assign(f,'C:\in.dat');
 reset(f);
 sobR:=0; sobY:=0; sobG:=0; sobB:=0;
 while not eof(f) do
       begin
       read(f,s);
       if s.Cvet='красный' then sobR:=sobR+(s.DlinaR*s.DlinaR*s.DlinaR);
       if s.Cvet='желтый' then sobY:=sobY+(s.DlinaR*s.DlinaR*s.DlinaR);
       if s.Cvet='зеленый' then sobG:=sobG+(s.DlinaR*s.DlinaR*s.DlinaR);
       if s.Cvet='синий' then sobB:=sobB+(s.DlinaR*s.DlinaR*s.DlinaR);
       end;
 writeln('Общий объем красных кубиков =',sobR);
 writeln('Общий объем желтых кубиков =',sobY);
 writeln('Общий объем зеленых кубиков =',sobG);
 writeln('Общий объем синих кубиков =',sobB);
 close(f);
 end.

uses crt;
 
type ucheniki = record;
     name: string[10];
     fam:  string[10];
     kl:   integer;
     kll:  string[1];
     oz: array [1..20] of integer;
     end;
 
var u: ucheniki;
    srsum: array [1..11] of real;
    i,j,k,n,m,sum,ku,r:integer;
    f,g: file of ucheniki;
 
begin
assign(f, 'C:\uch.dat');
rewrite(f);
write('Сколько учеников? ');
readln(n);
write('Сколько отметок у одного ученика? ');
readln(m);
writeln('Внесите данные об учениках: ');
for i:=1 to n do
    with u do
         begin
         write('Фамилия ',i,' учащегося: '); readln(fam);
         write('Имя: '); readln(name);
         write('Класс(цифра): '); readln(kl);
         write('Класс(буква): '); readln(kll);
         writeln('Oценки, всего ',m,': ');
         for j:=1 to m do readln(oz[j]);
         write(f,u);
         end;
close (f);
end.

uses crt;
 
type ucheniki = record;
     name: string[10];
     fam:  string[10];
     kl:   integer;
     kll:  string[1];
     oz: array [1..20] of integer;
     end;
 
var u: ucheniki;
    maxsum: array [1..11] of integer;
    i,j,k,n,m,sum,ku,r:integer;
    f,g: file of ucheniki;
 
begin
assign(f, 'C:\uch.dat');
assign(g, 'C:\luch.dat');
write('Сколько отметок у одного ученика? ');
for i:=1 to 11 do
     maxsum[i]:=0;
readln(m);
reset(f);
rewrite(g);
i:=0;
while not eof(f) do
      begin
      inc(i);
      read(f,u);
      sum:=0;
      with u do
           for j:=1 to m do
               inc(sum,oz[j]);
      if sum>=maxsum[u.kl] then maxsum[u.kl]:=sum;
 
      end;
writeln('Лучшие учащиеся: ');
i:=0;
reset(f);
while not eof(f) do
      begin
      inc(i);
      read(f,u);
      sum:=0; k:=0;
      with u do
      begin
      for j:=1 to m do
          begin
          inc(sum,oz[j]);
          if oz[j]>3 then inc(k);
          end;
      if (sum>=maxsum[u.kl]) and (k=m) then
         begin
            writeln(fam:11,name:11,kl:3,kll);
            write(g,u);
            end;
      end;
      end;
writeln('Данные о лучших учениках занесены в файл 2 ');
writeln('Нажмите 1, чтобы просмотреть содержимое файла 2 (сокращенно)');
readln(r);
if r=1 then
   begin
   reset(g);
   while not eof(g) do
         with u do
         begin
         read(g,u);
         writeln(fam:11,name:11,kl:3,kll);
         end;
   end;
close (f);
close (g);
end.