uses crt;
Function IOResult : Integer;
const g=6;
type
Tablica=record
Name:string[40]; //Название товара
Fir:integer; //Фирма изготовитель
Srok:integer; //Срок хранения
Stoim:string[20]; // Стоимость товара
Kol:integer; //Количество на складе
end;
var
users:file of Tablica; // Сам файл
k:1..g; // Счетчик для массива
work:array[1..g] of Tablica; //Массив записей для дальнейшей сортировки
NewTabl:string[15]; // Имя файла
n:1..4; // Кол-во для CASE
i:integer;
Procedure Name_file_for_tabl; // Задаем имя файла
begin
write('Введите имя файла данных ');
Readln(NewTabl);
End;
Procedure error(var i:integer); //Для ошибок связанных с отсутствием файла
begin 
Name_file_for_tabl;
Assign(users,NewTabl);
{$I-} //Проверка на то, что файл существует
Reset(users);
{$I+}
if IOResult<>0 then 
begin 
Writeln('Файла с именем '+NewTabl+' на диске нет');
i:=999;
delay(5000);
clrscr;
end
else i:=0;
end;
procedure input; // Происходит ввод файла
begin
Name_file_for_tabl; // Спрашиваем имя
 assign(users, NewTabl); 
 rewrite(users); //Создаем новый файл или перезаписываем
 for var k:= 1 to g do
 begin
  with work[k] do
  begin
   writeln ('Введите наименование товара: ');
   readln(Name);
   writeln ('Введите фирму изготовителя: ');
   readln (Fir);
   writeln ('Введите срок хранения: ');
   readln(Srok);
   writeln ('Введите стоимость товара: ');
   readln(Stoim);
   writeln ('Введите количество товара: ');
   readln(Kol);
  end;
 write(users,work[k]); 
 end;
close(users); //Закрываем файл.
  writeln('1 - Дальше. 2 - Выход');
  readln(n);
  if n=2 then halt(1);
end;
Procedure OutputRec; //Вывод одиночной записи.
Begin
Read(users,work[k]); 
with work[k] do
begin
write('Запись №',FilePos(users),';');
Writeln('Наименование товара: ',Name);
Writeln('Фирма изготовитель: ',Fir);
Writeln('Срок хранения: ',Srok);
Writeln('Стоимость товара: ',Stoim);
Writeln('Количество товара: ',Kol);
writeln();
end;
end;
procedure OutputAllRec; //Читает все записи
begin
error(i);
if i=999 then exit;
writeln('Вывод базы данных из файла ',NewTabl);
 for var k :=1 to g do
   if (not Eof(users)) then //Чтение до конца строки
     OutputRec; //Вывод отдельных записей
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
  writeln('|           Наименование товара          | Фирма изготовитель | Срок хранения |  Стоимость товара  | Количество товара |');
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
for var k:=1 to g do //Сортировка
  writeln('|', work[k].Name:40,'|',work[k].Fir:20,'|', work[k].Srok:15, '|', work[k].Stoim:20, '|', work[k].Kol:19, '|');
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
  close(users);//Закрываем файл.
    writeln('1 - Дальше. 2 - Выход');
  readln(n);
  if n=2 then halt(1);
  end;
Procedure Sort;  //Сортировка по возрастанию методом пузырька.
var
x:Tablica;
begin
error(i);
if i=999 then exit;
 for var i:=1 to g-1 do  
for var j:=i+1 to g do
 if work[i].name>work[j].name then
   begin
    x:=work[i];
    work[i]:=work[j];
    work[j]:=x;
   end;
 writeln('Применение возрастающей сортировки по количеству товара');
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
  writeln('|           Наименование товара          | Фирма изготовитель | Срок хранения |  Стоимость товара  | Количество товара |');
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
for var k:=1 to g do 
with work[k] do
  writeln('|', work[k].Name:40,'|',work[k].Fir:20,'|', work[k].Srok:15, '|', work[k].Stoim:20, '|', work[k].Kol:19, '|');
  writeln('*----------------------------------------*--------------------*---------------*--------------------*-------------------*');
  close(users);//Закрываем файл.
    writeln('1 - Дальше. 2 - Выход');
  readln(n);
  if n=2 then halt(1);
end;
begin
repeat
clrscr;
writeln('Что делать?');
writeln('1 - Создавать базу данных.');
writeln('2 - Смотреть базу данных. ');
writeln('3 - Сортировка по количеству товара.');
writeln('4 - Выход.');
readln(n);
case n of
1:input; 
2:OutputAllRec;
3:Sort;
end;
until (n=4);
halt(1);
end;
Begin
Readln;
end.

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.