Uses CRT;

Const
 g=6;

Type
 Tablica=record
          Name:string[20]; //Название товара
          Fir:string[20]; //Фирма изготовитель
          Srok:integer; //Срок хранения
          Stoim:integer; // Стоимость товара
          Kol_nom:integer; //Заданное количество товара
          Kol:integer; //Фактическое количество на складе
         end;
var
 users:file of Tablica; // Сам файл
 work:array[1..g] of Tablica; //Массив записей для дальнейшей сортировки
 NewTabl:string[15]; // Имя файла
 i,j,k,n:integer;

Procedure Name_file_for_tabl; // Задаем имя файла
 begin
  write('Введите имя файла данных ');
  Readln(NewTabl);
 end;

Function Err:boolean; //Для ошибок связанных с отсутствием файла
 begin
  Assign(users,NewTabl);
  {$I-} //Проверка на то, что файл существует
  Reset(users);
  {$I+}
  if IOResult<>0 then
   begin
    Err:=TRUE;
    clrscr;
   end
  else
   begin
    Err:=FALSE;
    Close(users);
   end;
 end;

Procedure input; // Происходит ввод файла
 begin
   assign(users, NewTabl);
   rewrite(users); //Создаем новый файл или перезаписываем
   for k:= 1 to g do
    begin
     with work[k] do
      begin
       write('Введите наименование товара: ');
       readln(Name);
       write('Введите фирму изготовителя: ');
       readln (Fir);
       write('Введите срок хранения: ');
       readln(Srok);
       write('Введите стоимость товара: ');
       readln(Stoim);
       write('Введите заданное количество товара: ');
       readln(Kol_nom);
       write('Введите фактическое количество товара: ');
       readln(Kol);
       writeln;
      end;
     write(users,work[k]);
    end;
  close(users); //Закрываем файл.
 end;

Procedure Form_Work; //Чтение данных из файла в массив.
 begin
  if Err then
   begin
    Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2 ');
    Readln(n);
    if n=1 then input;
   end
  else
   begin
    Reset(users);
    for k:=1 to g do Read(users,work[k]);
    Close(users);
   end;
 end;

procedure OutputAllRec(b:byte); //Выводит записи
// b=1 - все, b=2 - те, у которых фактическое количество не меньше заданного
 begin
  if Err then
   begin
    Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2');
    Readln(n);
    if n=1 then input;
   end
  else
   begin
    if b=1 then Form_Work;
    writeln('*---------------------*--------------------*-------*-------*--------*---------*');
    writeln('| Наименование товара | Фирма изготовитель | Ср.хр.| Стоим.|Кол.ном.|Кол.факт.|');
    writeln('*---------------------*--------------------*-------*-------*--------*---------*');
    for k:=1 to g do //Вывод
     if b=2 then
      begin
       if work[k].Kol>=work[k].Kol_nom then
        writeln('|', work[k].Name:20,' |',work[k].Fir:20,'|', work[k].Srok:7, '|', work[k].Stoim:7, '|', work[k].Kol_nom:8, '|', work[k].Kol:9,'|');
      end
     else
      writeln('|', work[k].Name:20,' |',work[k].Fir:20,'|', work[k].Srok:7, '|', work[k].Stoim:7, '|', work[k].Kol_nom:8, '|', work[k].Kol:9,'|');
    writeln('*---------------------*--------------------*-------*-------*--------*---------*');
    Readln;
   end;
 end;

Procedure Sort;  //Сортировка по возрастанию методом пузырька.
 var
  x:Tablica;
 begin
  if Not Err then
   begin
    Form_work;
    for i:=1 to g-1 do
     for j:=1 to g-i do
      if work[j].Kol>work[j+1].Kol then
       begin
        x:=work[j];
        work[j]:=work[j+1];
        work[j+1]:=x;
       end;
    writeln('Применение возрастающей сортировки по количеству товара');
    OutputAllRec(2);
   end
  else
   begin
    Write('Файла с именем '+NewTabl+' на диске нет. Создать? Да - 1, Нет - 2 ');
    Readln(n);
    if n=1 then input;
   end;
 end;

Begin
 clrscr;
 Name_file_for_tabl; // Спрашиваем имя
 Repeat
  clrscr;
  writeln('Что делать?');
  writeln('1 - Создавать базу данных.');
  writeln('2 - Смотреть базу данных. ');
  writeln('3 - Сортировка по количеству товара.');
  writeln('4 - Выход.');
  readln(n);
  case n of
   1:input;
   2:OutputAllRec(1);
   3:Sort;
  end;
 Until (n=4);
end.