|
Страница 10 из 39
Пример программы инвентаризации Для демонстрации того, как легко создать новые прикладные
программы при наличии базового набора процедур, рассмотрим прог-
рамму инвентаризации. Запись, используемая для хранения информа-
ции, выглядит следующим образом
type
inv = record
status: integer;
name: string[30];
descript := string[40];
guantity: integer;
cost: real;
end;
Длина ее, найденная с помощью SizeOf, равна 83. Используя данную
длину и длину ключа, равную 30, программа SETCONST.PAS создает
определение констант
Const
MaxDataRecSize = 82;
MaxKeyLen = 30;
PageSize = 24;
Order = 12;
PageStackSize = 10;
MaxHeight = 4;
Другие изменения, необходимые для преобразования процедур
ведения почтового списка в процедуры инвентаризации, заключаются
только в изменениях предложений печати. Целиком программа инвен-
таризации выглядит следующим образом:
program inventory;
Const
{ данные константы генерируются программой SETCONST.PAS
предоставляемой инструментарием баз данных }
MaxDataRecSize = 82;
MaxKeyLen = 30;
PageSize = 24;
Order = 12;
PageStackSize = 10;
MaxHeight = 4;
type
inv = record
status: integer;
name: string[30];
descript: string[40];
guantity: integer;
cost: real;
end;
{следующие файлы содержат процедуры баз данных}
{$i access.box} {основные процедуры баз данных}
{$i addkey.box} {добавить элементы }
{$i delkey.box} {удалить элементы }
{$i getkey.box} {поиск по дереву }
var
dbfile: DataFile;
ifile: IndexFile;
done: boolean;
function MenuSelect:char; {возврат пользовательского
выбора }
var
ch:char;
begin
WriteLn('1. Введите элемент ');
WriteLn('2. Удалить элемент ');
WriteLn('3. Отобразить инвентарный список');
WriteLn('4. Поиск элементов ');
WriteLn('5. Обновление ');
WriteLn('6. Выход ');
repeat
WriteLn;
Write('Введите ваш выбор: ');
Read(ch); ch:=UpCase(ch); WriteLn;
until (ch>='1') and (ch<='6');
MenuSelect:=ch;
end; {MenuSelect}
{добавить элемент к списку}
procedure Enter;
var
done: boolean;
recnum: integer;
temp: string[30];
info: inv;
begin
done:=FALSE;
repeat
Write('Введите имя элемента: ');
Read(info.name); WriteLn;
if Length(info.name)=0 then dont:=TRUE
else
begin
Write('Введите описание: ');
Read(info.descript); WriteLn;
Write('Введите количество: ');
Read(info.guantity); WriteLn;
Write('Введите стоимость: ');
Read(info.cost); WriteLn;
info.status:=0; { сделать активной }
FindKey(ifile, recnum, info.name);
if not OK then
begin
AddRec(dbfile, recnum, info);
AddKey(ifile, recnum, info.name};
end else WriteLn('дублированный ключ игнорирован');
end;
until done;
end; {Enter}
{изменение элемента в списке с сохранением поля имени}
procedure Update;
var
done: boolean;
recnum: integer;
temp: string[30];
info: inv;
begin
Write('Enter item name: ');
Read(info.name); WriteLn;
FindKey(ifile, recnum, info.name);
if OK then
begin
Write('Введите описание: ');
Read(info.descript); WriteLn;
Write('Введите количество: ');
Read(info.guantity); WriteLn;
Write('Введите стоимость: ');
Read(info.cost); WriteLn;
info.status:=0;
info.status:=0; {сделать активной}
PutRec(dbfile, recnum, info);
end else WriteLn('ключ не найден');
end; {Update}
{удалить элемент из инвентарного списка}
procedure Remove;
var
recnum: integer;
name: string[30];
begin
Write('Введите имя уничтожаемого элемента: ');
Read(name); WriteLn;
FindKey(ifile, recnum, name);
if OK then
begin
DeleteRec(dbfile, recnum);
DeleteKey(ifile, recnum, name);
end else WriteLn('Не найдено');
end; {Remove}
procedure Display(info: inv);
begin
WriteLn('Item name: ',info.name);
WriteLn('Description: ',info.descript);
WriteLn('Quantity on hand: ',info.quantity);
WriteLn('Initial cost: ',info.cost:10:2);
WriteLn;
end; {Display}
procedure ListAll;
var
info: inv;
len, recnum: integer;
begin
len := filelen(dbfile) -1;
for recnum:=1 to len do
begin
Getrec(dbfile, recnum, info);
if info.status = 0 then display(info);
end;
end; {ListAll}
{поиск элемента}
procedure Search;
var
name: string[30];
recnum: integer;
info: inv;
begin
Write('Введите имя элемента: ');
ReadLn(name);
{найти ключ, если он существует}
FindKey(ifile, recnum, name);
if OK then {если найден}
begin
GetRec(dbfile, recnum, info);
if info.status = 0 then Display(info);
end else WriteLn('не найден');
end; {Search}
begin
InitIndex;
OpenFile(dbfile, 'inv.lst', SizeOf(inv));
if not OK then
begin
WriteLn('Cоздание нового файла');
MakeFile(dbfile, 'inv.lst', SizeOf(inv));
end;
OpenIndex(ifile, 'inv.ndx', 30, 0);
if not OK then
begin
WriteLn('Cоздание нового файла');
MakeIndex(ifile, 'inv.ndx', 30, 0);
end;
done:=false;
repeat
case MenuSelect of
'1': Enter;
'2': Remove;
'3': ListAll;
'4': Search;
'5': Update;
'6': done:=true;
end;
until done;
CloseFile(dbfile);
CloseIndex(ifile);
end.
Программа ведения почтового списка и данная программа имеют
один базовый скелет. Он может быть модифицирован для различных
ситуаций использования баз данных.
|