program baza1; uses crt; const n=15; type tprod= record //Объявление записей. tsokr_name: string[20]; tfull_name: string[40]; tgod_vip: word; tproizvod: string[50]; tsklad: string[50]; tfzavsklad: string[50]; totv_mast: string[40]; tcategory: string[40]; topis: string; end; mass=array[1..20] of tprod; var fp: file of tprod; tmp: mass; sel: integer; dbname: string[20]; {Функция проверяющая наличие файла на диске} function findfile(naim:string):boolean; var fil:file of tprod; begin {$I-} //Отключение проверки ошибок ввода-вывода. assign(fil,naim); reset(fil); //Открытие файла для чтения. close(fil); //Закрытие файла. {$I+} //Включение проверки ошибок ввода-вывода. findfile:=(IOResult<>0) end; {Функция проверки наличия записей в файле} function f_rec(naim:string):boolean; var fil:file of tprod; i,klv:integer; head:tprod; begin assign(fil,naim); reset(fil); klv:=FileSize(fil); //Проверка размера файла. if klv>0 then begin clrscr; writeln('Имеющиеся в базе записи'); for i:=1 to klv do begin read(fil,head); writeln(i,' ',head.tsokr_name); end; end else begin clrscr; write('В базе нет записей'); readln; end; close(fil); f_rec:=(klv=0) end; {Процедура обеспечивающая ввод данных с клавиатуры} procedure vvod_dann; var i:integer; begin assign(fp,dbname); rewrite(fp); //Открытие файла для редактирования for i:=1 to n do begin clrscr; write('Введите сокращенное название ',i:2,' продукта => '); readln(tmp[i].tsokr_name); write('Введите его полное название => '); readln(tmp[i].tfull_name); write('Введите год выпуска => '); readln(tmp[i].tgod_vip); write('Введите производителя => '); readln(tmp[i].tproizvod); write('Введите номер склада => '); readln(tmp[i].tsklad); write('Введите фамилию завсклада => '); readln(tmp[i].tfzavsklad); write('Введите ответственного мастера => '); readln(tmp[i].totv_mast); write('Введите категорию => '); readln(tmp[i].tcategory); write('Введите краткое описание => '); readln(tmp[i].topis); write(fp,tmp[i]); end; close(fp) // Закрытие с сохранением внесенных изменений. end; {Процедура обеспечивающая добавление данных} procedure dobav_dann; label m1; var i,k:integer; klv:byte; head:tprod; begin assign(fp,dbname); reset(fp); if f_rec(dbname) then begin seek(fp,0); k:=1; goto m1 end; klv:=FileSize(fp); repeat write('Введите номер, под которым будет находиться новая запись => '); read(k); until k<=klv+1; if k=klv+1 then begin seek(fp,FileSize(fp)); goto m1 end; for i:=klv-1 downto k-1 do //Цикл с понижением значения. begin seek(fp,i); //Поиск read(fp,head); write(fp,head); end; m1: clrscr; readln; write('Введите сокращенное название продукта => '); readln(head.tsokr_name); write('Введите его полное название => '); readln(head.tfull_name); write('Введите год выпуска => '); readln(head.tgod_vip); write('Введите производителя => '); readln(head.tproizvod); write('Введите номер склада=> '); readln(head.tsklad); write('Введите фамилию завсклада => '); readln(head.tfzavsklad); write('Введите ответственного мастера => '); readln(head.totv_mast); write('Введите категорию => '); readln(head.tcategory); write('Введите краткое описание => '); readln(head.topis); seek(fp,k-1); write(fp,head); close(fp) end; {Редактирование данных} procedure edit_db; label m1; var i,k,sel_edit:integer; klv:byte; head:tprod; begin if f_rec(dbname) then goto m1; assign(fp,dbname); reset(fp); klv:=FileSize(fp); repeat write('Введите номер записи, которую необходимо отредактировать => '); read(k); until k<=klv; seek(fp,k-1); //к-1 потому что записи нумеруются с ноля. read(fp,head); repeat clrscr; writeln('Редактировать:'); writeln; writeln('1- Сокращенное название'); writeln; writeln('2- Полное название'); writeln; writeln('3- Год выпуска'); writeln; writeln('4- Производителя'); writeln; writeln('5- Номер склада'); writeln; writeln('6- Завскладом'); writeln; writeln('7- Ответственного мастера'); writeln; writeln('8- Категорию'); writeln; writeln('9- Описание'); writeln; writeln('10- Запись'); writeln; writeln('0- Завершить редактирование'); writeln; write ('Ваш выбор => '); readln(sel_edit); //Ждем реакции пользователя. clrscr; //Очистка экрана. case sel_edit of //Выбор действия в зависимости от 1:begin // введенного значения. write('Введите сокращенное название => '); readln(head.tsokr_name); seek(fp,k-1); write(fp,head); seek(fp,0) end; 2:begin write('Введите полное название => '); readln(head.tfull_name); seek(fp,k-1); write(fp,head); seek(fp,0) end; 3:begin write('Введите год выпуска => '); readln(head.tgod_vip); seek(fp,k-1); write(fp,head); seek(fp,0) end; 4:begin write('Введите производителя => '); readln(head.tproizvod); seek(fp,k-1); write(fp,head); seek(fp,0) end; 5:begin write('Введите номер склада => '); readln(head.tsklad); seek(fp,k-1); write(fp,head); seek(fp,0) end; 6:begin write('Введите завскладом => '); readln(head.tfzavsklad); seek(fp,k-1); write(fp,head); seek(fp,0) end; 7:begin write('Введите ответственного мастера => '); readln(head.totv_mast); seek(fp,k-1); write(fp,head); seek(fp,0) end; 8:begin write('Введите категорию => '); readln(head.tcategory); seek(fp,k-1); write(fp,head); seek(fp,0) end; 9:begin write('Введите описание => '); readln(head.topis); seek(fp,k-1); write(fp,head); seek(fp,0) end; 10:begin write('Введите сокращенное название продукта => '); readln(head.tsokr_name); write('Введите его полное название => '); readln(head.tfull_name); write('Введите год выпуска => '); readln(head.tgod_vip); write('Введите производителя => '); readln(head.tproizvod); write('Введите номер склада=> '); readln(head.tsklad); write('Введите фамилию завсклада => '); readln(head.tfzavsklad); write('Введите ответственного мастера => '); readln(head.totv_mast); write('Введите категорию => '); readln(head.tcategory); write('Введите краткое описание => '); readln(head.topis); seek(fp,k-1); write(fp,head); seek(fp,0) end; end; until sel_edit=0; m1: close(fp) end; {Процедура выполняющая удаление данных} procedure udal_dann; label m1; var i,k:integer; klv:byte; head:tprod; begin if f_rec(dbname) then goto m1; assign(fp,dbname); reset(fp); klv:=FileSize(fp); repeat write('Введите номер записи, которую необходимо удалить => '); read(k); until k<=klv; for i:=k to klv-1 do begin seek(fp,i); read(fp,head); seek(fp,i-1); write(fp,head); end; seek(fp,klv-1); truncate(fp); m1: close(fp); end; {Процедура поиска по номеру записи} procedure find_num; label m1; var i,k:integer; klv:byte; head:tprod; begin if f_rec(dbname) then goto m1; assign(fp,dbname); reset(fp); klv:=FileSize(fp); repeat write('Введите номер записи, которую необходимо посмотреть => '); read(k); until k<=klv; seek(fp,k-1); read(fp,head); clrscr; writeln('Запрошен № ',k); writeln('Сокращенное название => ',head.tsokr_name); writeln('Полное название => ',head.tfull_name); writeln('Год выпуска => ',head.tgod_vip); writeln('Производитель => ',head.tproizvod); writeln('Склад => ',head.tsklad); writeln('Завскладом => ',head.tfzavsklad); writeln('Отв. мастер => ',head.totv_mast); writeln('Категория => ',head.tcategory); writeln('Описание => ',head.topis); writeln; write('ENTER для продолжения => '); readln; readln; m1: close(fp) end; {Процедура выполняющая поиск по значению} procedure poisk_znach; label m1; var c,i,m,n:integer; klv:byte; st,tword:string; head:tprod; begin if f_rec(dbname) then goto m1; assign(fp,dbname); reset(fp); klv:=FileSize(fp); clrscr; write('Введите ключевое слово => '); read(tword); writeln; c:=0; for i:=1 to klv do begin seek(fp,i-1); read(fp,head); st:=head.tsokr_name; m:=pos(tword,st); st:=head.topis; n:=pos(tword,st); if (m>0) or (n>0) then begin clrscr; writeln('Найдено в № ',i); writeln('Сокращенное название => ',head.tsokr_name); writeln('Полное название => ',head.tfull_name); writeln('Год выпуска => ',head.tgod_vip); writeln('Производитель => ',head.tproizvod); writeln('Склад => ',head.tsklad); writeln('Завсклад => ',head.tfzavsklad); writeln('Отв. мастер => ',head.totv_mast); writeln('Категория => ',head.tcategory); writeln('Описание => ',head.topis); writeln; write('ENTER для продолжения => '); readln; readln; inc(c) end; end; if c=0 then begin write('По вашему запросу ничего не найдено'); readln; readln; end; m1: close(fp); end; {Основной текст программы} Begin TextBackGround (blue); //Задаем цвет фона. TextColor (yellow); //Задаем цвет букв. ClrScr; dbname:='c:\baza_mat.dat'; if findfile(dbname) then vvod_dann; assign(fp,dbname); reset(fp); if f_rec(dbname) then dobav_dann; repeat clrscr; writeln ('База данных материалов'); writeln; //Меню возможных writeln ('1- Добавить'); writeln; //операций. writeln ('2- Редактировать'); writeln; writeln ('3- Удалить'); writeln; writeln ('4- Найти по номеру'); writeln; writeln ('5- Найти по значению'); writeln; writeln ('0- Завершение работы'); writeln; write ('Вы выбрали => '); readln(sel); //Ожидание реакции пользователя. case sel of //Выбор действия 1:dobav_dann; 2:edit_db; 3:udal_dann; 4:find_num; 5:poisk_znach; end; until sel=0; reset(fp); close(fp) end.