ПрИЛОЖЕНИЕ 3
пример выполнения
контрольной работы № 10
Алгоритмически контрольная работа № 10 ничем не отличается от работ № 8, 9. Структура записи RecType полностью аналогична структуре, данной в П.1.1. База данных (БД) может быть введена из файла записей, который можно создать, используя контрольные работы № 9 или 10 (структура файла записей в обеих работах одинакова - см. рис. П.2.1). Однако, если в контрольной работе № 9 редактирование БД выполнялось непосредственно во временном файле basa.tmp, то в данной работе - в динамической области оперативной памяти, называемой «куча» (см. Прил. 6). При этом структура БД представляет собой однонаправленный список, аналогичный списку, представленному на рис. П.6.16. Информационная часть inf является записью RecType, кроме того, добавлен еще номер записи number : Word.
 |
|||
|
|||
 |
||||
|
||||
Рис. П.3.1. Структура списка в процессе
его создания.
На алгоритмическом языке Pascal это описание имеет следующий вид:
Pointer=^ListType;
ListType=
{однонаправленный
список}
Record
number : Word; {номер
записи}
inf : RecType;
next :Pointer;
End;
Var
PointerFirst, {указатель
на первую запись}
PointerPred, {указатель
на предыдущую запись}
PointerNew,
{указатель на новую запись}
............
: Pointer;
Как видно из прил. 6, обработка
списка сводится к работе с указателями.
БД может формироваться и путем
непосредственного ввода с клавиатуры полей
записи в динамическую область памяти.
По окончании работы программы
БД может быть (по желанию пользователя)
переписана в файл, для чего запрашивается
имя файла. При этом, если файл с таким именем
не существует, он создается, а если
существует, - то перезаписывается.
В данной работе используются те же модули, что и в предыдущей работе: Input, File_Rec.
ЛИСТИНГ ПРОГРАММЫ Work10.pas
{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M
16384,0,655360}
program
Work10;
{
Вариант №
40.
Создать список записей
в соответствии с заданной структурой.
Количество
записей <=65535 (ограничено диапазоном
переменной типа WORD)
или размером кучи.
Реализовать редактирование
записей (изменение, добавление, удаление).
Исходные данные должны вводиться с
проверкой на область допустимых значений.
Реализовать в соответствии со своим
вариантом запрос: «Определить общее
количество товара, поступившего за
определенный год» и
вывод содержимого записи по определенным
ключам. Предусмотреть вывод всей базы
данных на экран. Вся обработка базы данных
должна происходить путем выбора
соответствующего пункта из меню.
Результат (база данных) должен
запоминаться тоже в файле и быть доступен
для последующей (многократной) обработки. В
реализации должны быть предусмотрены
модули
(TPU). }
Uses
Crt, Dos, Input, File_Rec;
Const
ColRec=65535;
{Максимальное количество записей}
LenNaimt=27;{Максимальная
длина наименования товара}
Err1='Число
записей больше максимального - операция
НЕВОЗМОЖНА!!!!';
Err2='
НЕ хватает памяти в куче для записи
номер ';
Err3='Дальнейший
ввод записей невозможен. ';
Err4='
Число записей больше максимального или
';
Enter='Нажмите
ENTER............';
EnterOrSpace='Нажмите
ENTER или ПРОБЕЛ...';
EmptyStr='
';
Empty='';
EmptyFile='
Файл записей пуст. ';
EmptyHeap='
В куче записей нет!!!
';
NoFile='Файл
записей не существует!!! ';
Continue='Для
окончания операции введите ESC, для
продолжения - Enter';
CaseStr='Выберите
курсором нужный режим. ';
RecNotFound='Запись
НЕ найдена!!!! ';
Shure='Вы
уверены, что это нужная запись? (Y/N)';
Konec='Работа с базой данных закончена. ';
Inv1='Ввод
базы данных';
Inv2='Вывести
данные на экран';
Inv3='Вычислить
общее количество товаров за определенный
год';
Inv4='Вывести
содержимое записи по ключу';
Inv5='Добавить
запись';
Inv6='Изменить
запись';
Inv7='Удалить
запись';
YearMin=1990;
{Минимальный год}
YearMax=2000;
{Максимальный год}
FileL
=12; {Максимальная
длина файла в MS DOS}
type
data=
record
day : byte;
year : word;
month : byte;
end;
RecType=
record
naimt : string[LenNaimt];
kolt : longint;
stoimt : real;
dmg : data;
end;
Pointer=^ListType;
ListType= {однонаправленный
список}
Record
number : Word; {номер записи}
inf : RecType;
next :Pointer;
End;
var
Rec : RecType;
ch : char;
MaxElem : word;
FileName : string[FileL];
ff : file of RecType;
PointerFirst, {указатель
на первую запись}
PointerPred,
{указатель на предыдущую запись}
PointerNew,
{указатель на новую запись}
P,
{маркированный указатель для Mark-Release}
Current : Pointer;
{текущий указатель на запись}
{Процедура вывода верхней части
шапки таблицы }
Procedure
TopT;
begin
writeln('??? ??
?? ??
?? ????????????????????
??');
writeln('? Запись? Наименование ? Кол-во ? Стоимость? Год ? Месяц? День?');
writeln('??? ??
?? ???????????????????????????
??');
end;
{Процедура вывода нижней части
шапки таблицы}
Procedure
EndT;
begin
write( '???
??? ??
?? ??????????????????
????
?');
end;
{Процедура ввода значений элементов
полей записи}
Procedure
InputFields(var rec : RecType);
Var a : real;
s : String;
begin
InputString(S, LenNaimt, 'Наименование');
Rec.naimt:=s;
InputNumber(a,0,2147483647,10,'Количество');
Rec.kolt:=trunc(a);
InputReal(a,11,'Стоимость');
rec.stoimt:=a;
InputNumber(a,YearMin,YearMax,4,'Год');
rec.dmg.year:=trunc(a);
InputNumber(a,1,12,2,'Месяц');
rec.dmg.month:=trunc(a);
InputNumber(a,1,31,2,'День');
rec.dmg.day:=trunc(a);
end;
Procedure
OutputRec(rec : RecType);
begin
Write('?',Rec.naimt);
Gotoxy(36,Wherey);
Write('?',Rec.kolt:10);
Gotoxy(47,Wherey);
Write('?',Rec.stoimt:11:2);
Gotoxy(59,Wherey);
Write('?',Rec.dmg.year:5);
Gotoxy(65,Wherey);
Write('?',Rec.dmg.month:3);
Gotoxy(71,Wherey);
Write('?',Rec.dmg.day:3);
Gotoxy(76,Wherey);
Writeln('?');
end;
{Проверка возможности непрерывного
размещения записи ListType
в куче}
Function
NoAllocate(Var i : Word):boolean;
Begin
NoAllocate:=False;
if (i>ColRec) or (MaxAvail < SizeOf(ListType)) then
begin
OutMessageXY(10,22,Err4,Empty);
OutMessageXY(10,23,Err2,IntToStr(i));
OutMessageXY(10,24,Err3,Enter);
Readln;
i:=i-1;
{Игнорируем эту запись}
NoAllocate:=True;
end
End;
{Формирование списка записей}
Procedure
FormList(i : Word; mas : RecType);
Begin
{ Распределяем память в "куче" размером ListType}
GetMem(PointerNew,
SizeOf(ListType));
if i = 1 then PointerFirst:=PointerNew; {Запоминаем
первый указатель}
{связывание указателей}
PointerNew^.Next:=Nil; {Указатель на следующий элемент, которого еще нет, Nil}
if
PointerPred<>NIL then PointerPred^.Next:=PointerNew;
{формирование списка записей}
PointerNew^.Number:=i;
PointerNew^.Inf:=mas;
{ или
пересылаем отдельно каждое поле:
PointerNew^.Inf.naimt:=mas.naimt;
PointerNew^.Inf.kolt:=mas.kolt;
PointerNew^.Inf.stoimt:=mas.stoimt;
PointerNew^.Inf.dmg.year:=mas.dmg.year;
PointerNew^.Inf.dmg.month:=mas.dmg.month;
PointerNew^.Inf.dmg.day:=mas.dmg.day;
}
PointerPred:=PointerNew;
End;
{Создание с клавиатуры записей в "куче"}
Procedure
InputRecord(var MaxElem : word);
Var
i : Word;
ch : Char;
mas : RecType;
begin
i:=0;
repeat
clrscr;
inc(i);
if NoAllocate(i) then break;
InputFields(mas);
FormList(i, mas);
OutMessageXY(12,23,Continue,Empty);
ch:=Readkey;
until ch=#27;
MaxElem:=i;
end;
Procedure
OutRecord(MaxElem : integer);
Var i : Word;
mas : RecType;
begin
clrscr;
if MaxElem<>0 then
begin
TopT;
Current:=PointerFirst;
for i:=1 to MaxElem do
begin
mas:=Current^.Inf;
Write('?',Current^.Number:6);
OutputRec(mas);
Current:=Current^.Next;
end;
EndT;
OutMessageXY(20,24,Empty,Enter);
end
else OutMessageXY(20,24,EmptyHeap,Enter);
readln;
end;
Procedure
Zapros1;
Var a,
Sum : Real;
god, i : Word;
mas : RecType;
begin
Clrscr;
Writeln('Вычислить общее количество
товаров за определенный год');
InputNumber(a,YearMin,YearMax,4,'Год');
god:=trunc(a);
sum:=0;
TopT;
Current:=PointerFirst;
for i:=1 to MaxElem do
begin
mas:=Current^.Inf;
if mas.dmg.year=god then
begin
sum:=sum + mas.kolt;
Write('?',Current^.Number:6);
OutputRec(mas);
end;
Current:=Current^.Next;
end;
EndT;
Writeln;
if sum<>0 then
begin
Writeln('Суммарное количество товара за ',god,'
год составляет ',sum:12:0);
OutMessageXY(20,24,Empty,Enter);
end
else OutMessageXY(10,24,RecNotFound,Enter);
readln;
end;
{Поиск и возможная выдача на экран (f = TRUE) записи с номером i}
Procedure
Search(i : Word; f : boolean);
Begin
Current:=PointerFirst;
if
i=1 then
begin
if f then
begin
Write('?',PointerFirst^.Number:6);
OutputRec(PointerFirst^.Inf);
end;
PointerPred:=Nil; {предыдущего элемента нет}
end
else
begin
while Current<>Nil do
if Current^.Number=i then
begin
if f then
begin
Write('?',Current^.Number:6);
OutputRec(Current^.Inf);
end;
break;
end
else
begin
PointerPred:=Current;
Current:=Current^.Next;
end
end
End;
Procedure
KeyRec;
var ch : char;
r, st : Real;
f, f1 : Boolean;
Num, J, god : Word;
Str : String;
mas : RecType;
Label 1;
begin
repeat
f:=true;
clrscr;
if MaxElem=0 then
begin
OutMessageXY(20,24,EmptyHeap,Enter);
Readln;
Exit;
end;
writeln('Вывести содержимое записи по ключу');
writeln('1: номер
записи');
writeln('2: наименование
товара');
writeln('3: стоимость
товара');
writeln('4: год
поступления товара');
Writeln;
Writeln('Введите нужный ключ');
ch:=Readkey;
case ch of
'1': begin
InputNumber(r,1,MaxElem,2,' Введите
номер записи');
Num:=trunc(r);
end;
'2': InputString(Str, LenNaimt, ' Введите
наименование товара');
'3': InputReal(st,11,' Введите стоимость товара');
'4': begin
InputNumber(r,YearMin,YearMax,4,'
Введите год поступления товара');
god:=trunc(r);
end
else
begin
Clrscr;
Writeln('Неизвестное значение ключа');
OutMessageXY(20,24,Empty,Enter);
readln;
f:=false;
end;
end;
until f;
f:=false; {Логический признак
нормального завершения работы}
f1:=false;
{Логический признак выдачи нужной
записи}
ClrScr;
Current:=PointerFirst;
{установка указателя на первую запись}
TopT;
if ch='1' then
begin
Search(num, true);
f:=true;
goto 1
end;
while Current<>Nil do
begin
mas:=Current^.Inf;
case ch of
'2': if str=mas.naimt then
begin
f:=true;
f1:=true;
end;
'3': if st=mas.stoimt then
begin
f:=true;
f1:=true;
end;
'4': if god=mas.dmg.year then
begin
f:=true;
f1:=true;
end;
end;
if f1 then
begin
Write('?',Current^.Number:6);
OutputRec(mas);
f1:=false
end;
Current:=Current^.Next;
end;
1:
EndT;
if f then OutMessageXY(20,24,Empty,Enter)
else OutMessageXY(10,24,RecNotFound,Enter);
Readln
end;
{Процедура изменения (Flag=True) или удаления (Flag=False) записи}
Procedure
ChangeDel(flag : boolean);
Var ch : char;
i, j : Word;
Pw : Pointer;
begin
if MaxElem=0 then
begin
OutMessageXY(1,24,EmptyStr,Empty);{Очистка
строки сообщения}
OutMessageXY(10,24,EmptyHeap,Enter);
Readln;
Exit
end;
repeat
clrscr;
if flag then write('Введите
номер изменяемой записи
===>')
else write('Введите номер удаляемой записи
===>');
{$I-}
Readln(i);
{$I+}
until (IOResult=0)and(i>0) and (i<=MaxElem);
TopT;
Search(i, true);
{поиск записи с номером i}
EndT;
writeln;
OutMessageXY(20,24,Shure,Empty);
ch:=ReadKey;
if (ch='y')or(ch='Y')then
begin
if flag then {изменение
записи номер i}
InputFields(Current^.Inf) {Ввод всех полей заново}
else {удаление
записи номер i}
begin
if PointerPred=Nil then {первая
запись}
begin
Pw:=PointerFirst;
Current:=Pw^.Next;
PointerFirst:=Current;
FreeMem(Pw, SizeOf(ListType));
end
else
begin
PointerPred^.Next:=Current^.Next;
FreeMem(Current, SizeOf(ListType));
Current:=PointerPred^.Next;
end;
While Current<>Nil do
begin
Dec(Current^.Number); {изменение номеров записей}
Current:=Current^.Next
end;
MaxElem:=MaxElem-1;
end;
if not flag then OutMessageXY(20,24,'Запись
удалена. ',Enter)
else OutMessageXY(20,24,'Запись
изменена. ',Enter);
readln;
end
end;
{Процедура добавления записи}
Procedure
AddRecord;
Var i, j : Word;
begin
repeat
clrscr;
Write('Введите номер добавляемой записи
===>');
{$I-}
readln(i);
{$I+}
until (IOResult=0)and (i>0) and (i<=MaxElem+1);
MaxElem:=MaxElem+1;
if NoAllocate(MaxElem) then exit;
Search(i, False);
GetMem(PointerNew, SizeOf(ListType));
InputFields(PointerNew^.Inf);
PointerNew^.Number:=i;
if PointerPred=Nil then {первая
запись}
begin
PointerNew^.Next:=PointerFirst;
PointerFirst:=PointerNew;
end
else
begin
PointerNew^.Next:=PointerPred^.Next;
PointerPred^.Next:=PointerNew;
end;
While Current<>Nil do
begin
Inc(Current^.Number);
Current:=Current^.Next
end;
OutMessageXY(20,24,'Запись добавлена. ',Enter);
readln;
end;
{Процедура коррекции положения
курсора при движении стрелки вверх-вниз}
Procedure
UpDown(var Vari : integer; Im : byte);
begin
if ch=#0 then ch:=readkey;
case ch of
#72:
begin
{стрелка вверх ?}
if vari=1 then vari:=im
else vari:=vari-1;
gotoxy(1,vari);
end;
#80: begin {стрелка вниз ?}
if vari=im then vari:=1
else vari:=vari+1;
gotoxy(1,vari);
end;
end;
end;
{Процедура создания базы данных в
"куче"}
Procedure
CreateDB(Var MaxElem : word);
var i, j : word;
Str : String;
mas : RecType;
begin
Clrscr;
writeln('1-
Использовать существующий файл базы данных');
writeln('2-
Создать новую базу данных с клавиатуры');
OutMessageXY(25,24,'Введите
нужный ключ. ',Empty);
repeat
{$I-}
readln(i);
{$I+}
until (IoResult=0) and ((i=1) or (i=2));
case i of
1: begin
Clrscr;
DirCat;
Repeat
InputString(Str, FileL,' Введите
имя файла
базы данных');
FileName:=Str;
until Pust(FileName, True);
assign(ff, FileName); {Открыть файл
FileName на чтение}
reset(ff);
j:=0;
While not eof(ff) do
begin
j:=j+1;
if NoAllocate(j) then break{goto L1};
read(ff, mas); {Читаем
запись и размещаем ее в "куче"}
FormList(j, mas);
end;
MaxElem:=j;
close(ff);
end;
2 : InputRecord(MaxElem);
end;
end;
{Функция организации главного меню}
Function
MainMenu : boolean;
const i : integer=1; {начальное положение
курсора}
var k : char;
name : string;
j : word;
begin
MainMenu:=false;
clrscr;
Writeln(Inv1);
Writeln(Inv2);
Writeln(Inv3);
Writeln(Inv4);
Writeln(Inv5);
Writeln(Inv6);
Writeln(Inv7);
Writeln('Выход');
OutMessageXY(15,24,CaseStr,Enter);
Gotoxy(1,i);
repeat
ch:=readkey;
if( ch=#32) or (ch=#13)then
begin
case i of
1: CreateDB(MaxElem);
{Создать базу данных}
2: OutRecord(MaxElem);
{Вывести данные на экран}
3: Zapros1; {Вычислить
общее количество товаров за определенный
год}
4: KeyRec; {Вывести
содержимое записи по ключу}
5: AddRecord; {Добавить
запись}
6: ChangeDel(true); {Изменить запись}
7: ChangeDel(false); {Удалить
запись}
8: Begin {Выход}
Mainmenu:=true;
Clrscr;
if MaxElem<>0 then
Begin
Writeln('Сохранить базу данных? (Y/N)');
k:=ReadKey;
If (k='y') or (k='Y') then
begin
ClrScr;
DirCat;
InputString(Name, FileL, 'Введите имя файла для
сохранения базы данных');
Assign(ff, name);
Rewrite(ff);
Current:=PointerFirst;
for j:=1 to MaxElem do
begin
Write(ff, Current^.Inf);
Current:=Current^.Next;
end;
Close(ff);
OutMessageXY(10,24,Konec,Enter);
readln;
end;
end;
Exit;
end;
end;
exit;
end
else UpDown(i,8);
until false;
end;
{Главная программа}
begin
clrscr;
MaxElem:=0;
PointerPred:=Nil;
Mark(P); {запомнить начальный адрес
динамической памяти ("кучи")}
repeat
until MainMenu;
if P<>Nil then Release(P); {освободить
динамическую память}
end.
