Необходимо ввести и сохранить в файле данные следующей структуры
Ввести и сохранить в файле данные следующей структуры:
наименование товара, фирма изготовитель, срок хранения, стоимость товара,
количество на складе. Организовать просмотр исходных данных и вывести
список товаров, количество на складе которых не меньше заданного,
отсортированный по возрастанию методом пузырька, с указанием срока
хранения и стоимости.
Ввод и вывод данных организовать в виде таблиц. Отладку программы
производить на примере файла, состоящего не менее чем из 15 записей.
Не компилируется и выдаёт ошибку Встречено '.', а ожидалось ';' для последнего end. Если добавить begin end. то всё компилируется но не выполняется, а просто закрывается. Помогите найти ошибки. Я новичок в паскале. Пользуюсь если что Pascal ABC.net.
Ввести и сохранить в файле данные следующей структуры:
наименование товара, фирма изготовитель, срок хранения, стоимость товара,
количество на складе. Организовать просмотр исходных данных и вывести
список товаров, количество на складе которых не меньше заданного,
отсортированный по возрастанию методом пузырька, с указанием срока
хранения и стоимости.
Ввод и вывод данных организовать в виде таблиц. Отладку программы
производить на примере файла, состоящего не менее чем из 15 записей.
Код:
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.
