Главная Случайная страница Контакты | Мы поможем в написании вашей работы! | ||
|
{Разработать программу, создающую файл записей, содержащий
информацию о проживающих в гостиничном комплексе (фамилия,
занимаемый номер, дата приезда, дата отъезда). Реализовать
процедуры добавления новых записей, поиска по фамилии, вывода
информации начиная с конкретной даты, удаление записей,
сортировки файла по возрастанию номеров апартаментов.}
Program TipFile;
Uses Crt;
Const
FLOOR=5; {число этажей в гостинице}
APPART=20; {число номеров на этаже}
TEX_1='Ввод';
TEX_2='Сообщения';
TEX_3='| Фамилия |Занимаемый номер|Дата приезда|Дата отъезда';
Type
TData=Record
gg,mm,dd:Byte;
End;
TZap=Record
fam:String; {фамилия проживающего}
nomer:Word; {занимаемый номер}
data_pr,
data_ot:TData; {дата приезда, дата отъезда}
End;
TFZ= File Of TZap;
{Процедура рисования окна диалога}
Procedure Okno(xv,yv,xn,yn,colfona,colbukv:Byte;zag:String);
Var
i:Integer;
Begin
Window(xv,yv,xn,yn);
TextColor(colbukv);
TextBackGround(colfona);
ClrScr;
GoToXY((xn-xv) Div 2 - Length(zag) Div 2,1);
Write(zag);
Window(xv+2,yv+2,xn-2,yn-3);
End;
{Проверка наличия файла с указанным именем}
Function FileExist(fname:String):Boolean;
Var
f:TFZ;
Begin
Assign(f,fname);
{$i-}
Reset(f);
{$i+}
If IOResult <> 0
Then FileExist:=FALSE
Else Begin
FileExist:=TRUE;
Close(f);
End;
End;
{Создание нового файла}
Procedure SozdFZ(fname:String);
Var
z:TZap;
i:1..FLOOR;
j:1..APPART;
otv:CHAR;
fz:TFZ;
Begin
If FileExist(fname)
Then Begin
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Файл ',fname,' уже существует.');
WriteLn('Хотите создать новый с тем же');
Write('именем? д/н->');
ReadLn(otv);
If Not (otv In ['l','L','д','Д'])
Then Exit;
End;
Assign(fz,fname); ReWrite(fz);
Window(1,1,80,25);
TextBackGround(1);
ClrScr;
Repeat
Okno(2,2,45,18,14,10,TEX_1);
ClrScr;
WriteLn('Добавляется новая запись:');
WriteLn;
With z
Do Begin
Write(' ФИО проживающего..'); ReadLn(fam);
Write(' занимаемый номер..'); ReadLn(nomer);
i:=z.nomer Div 100;
j:=z.nomer-i*100;
If(i<1)Or(i>FLOOR)Or(j<1)Or(j>APPART)
Then Begin
WriteLn('Ошибка в указании номера');
WriteLn('Повторите ввод после нажатия ENTER');
ReadLn; Continue;
End;
Write('дата приезда: год.(гг)..');ReadLn(data_pr.gg);
Write(' месяц.(мм)..');ReadLn(data_pr.mm);
Write(' день.(дд)..');ReadLn(data_pr.dd);
Write('дата отъезда: год.(гг)..');ReadLn(data_ot.gg);
Write(' месяц.(мм)..');ReadLn(data_ot.mm);
Write(' день.(дд)..');ReadLn(data_ot.dd);
If (data_pr.gg>data_ot.gg)Or
((data_pr.gg=data_ot.gg)And(data_pr.mm>data_ot.mm))Or
((data_pr.gg=data_ot.gg)And(data_pr.mm=data_ot.mm)And
(data_pr.dd>data_ot.dd))
Then Begin
WriteLn('Ошибка в наборе дат.');
WriteLn('Повторите ввод после нажатия ENTER');
ReadLn; Continue;
End;
End;
Write(fz,z);
Write('Продолжать ввод?..д/н..'); ReadLn(otv);
Until Not (otv In ['l','L','д','Д']);
Close(fz);
End;
{Сортировка файла вторичному ключу (по занятым номерам апартаментов)}
Procedure Sort_Fz(fname:String);
Var
z1,z2:TZap;
fp:Boolean;
i,nom:Integer;
fz:TFZ;
Begin
If Not FileExist(fname)
Then Begin
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('файл ',fname,' не существует, сортировка невозможна');
Exit;
End;
Assign(fz,fname); Reset(fz);
nom:=FileSize(fz)-1;
Repeat
fp:=FALSE;
For i:=0
To nom-1
Do Begin
Seek(fz,i);
Read(fz,z1,z2);
If z1.nomer>z2.nomer
Then Begin
Seek(fz,FilePos(fz)-2);
Write(fz,z2,z1);
fp:=true;
End;
End;
Until Not fp;
Close(fz);
End;
{Печать существующих записей, начиная с указанной даты}
Procedure ProsmFz(fname:String; den:TData);
Var
z:TZap;
i:Byte;
fz:TFZ;
Begin
If Not FileExist(fname)
Then Begin
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Файл ',fname,' не существует');
WriteLn('Просмотр невозможен');
WriteLn('Нажмите ENTER');
ReadLn; Exit;
End;
Okno(1,1,80,25,13,10,'');
ClrScr;
Write('С ');
If den.dd<10 Then Write('0');
Write(den.dd,'.');
If den.mm<10 Then Write('0');
Write(den.mm,'.');
If den.gg<10 Then Write('0');
WriteLn(den.gg,' в гостинице проживали:');
WriteLn;
WriteLn(' ',TEX_3);
Assign(fz,fname); Reset(fz);
i:=3;
WHILE Not EOF(fz)
Do Begin
Inc(i);
Read(fz,z);
With z Do
Begin
If(den.gg<data_ot.gg)Or
((den.gg=data_ot.gg)And(den.mm<data_ot.mm))Or
((den.gg=data_ot.gg)And(den.mm=data_ot.mm)And
(den.dd<=data_ot.dd))
Then Begin
Write(' | ');
GoToXY(9,i); Write(fam);
GoToXY(25,i); Write('| ',nomer);
With data_pr Do
Begin
Write(' | ');
If dd<10 Then Write('0');
Write(dd,'.');
If mm<10 Then Write('0');
Write(mm,'.');
If gg<10 Then Write('0');
Write(gg);
End;
With data_ot Do
Begin
Write(' | ');
If dd<10 Then Write('0');
Write(dd,'.');
If mm<10 Then Write('0');
Write(mm,'.');
If gg<10 Then Write('0');
Write(gg);
End;
End;
End;
WriteLn;
If i=20
Then Begin
Write('Для продолжения нажмите ENTER');
ReadLn;
i:=0;
ClrScr; WriteLn;
End;
End;
WriteLn;
WriteLn('Для продолжения нажмите ENTER');
ReadLn;
Window(1,1,80,25);
TextBackGround(1);
ClrScr;
Close(fz);
End;
{Процедура добавления новых записей}
Procedure Dobavl(fname:String);
Var
z:TZap;
otv:CHAR;
i:1..FLOOR;
j:1..APPART;
fz:TFZ;
Begin
Assign(fz,fname);
If Not FileExist(fname)
Then ReWrite(fz)
Else Begin
Reset(fz);
Seek(fz,FileSize(fz));
End;
Repeat
Okno(2,2,45,18,14,10,TEX_1);
ClrScr;
WriteLn('Добавляется новая запись:'); WriteLn;
With z
Do Begin
Write('ФИО проживающего..'); ReadLn(fam);
Write('занимаемый номер..'); ReadLn(nomer);
i:=z.nomer Div 100;
j:=z.nomer-i*100;
If(i<1)Or(i>FLOOR)Or(j<1)Or(j>APPART)
Then Begin
WriteLn('Ошибка в указании номера');
WriteLn('Повторите ввод после нажатия ENTER');
ReadLn; Continue;
End;
Write('дата приезда: год.(гг)..');ReadLn(DATA_pr.gg);
Write(' месяц.(мм)..');ReadLn(DATA_pr.mm);
Write(' день.(дд)..');ReadLn(DATA_pr.dd);
Write('дата отъезда: год.(гг)..');ReadLn(DATA_ot.gg);
Write(' месяц.(мм)..');ReadLn(DATA_ot.mm);
Write(' день.(дд)..');ReadLn(DATA_ot.dd);
If(data_pr.gg>data_ot.gg)Or
((data_pr.gg=data_ot.gg)And(data_pr.mm>data_ot.mm))Or
((data_pr.gg=data_ot.gg)And(data_pr.mm=data_ot.mm)And
(data_pr.dd>data_ot.dd))
Then Begin
WriteLn('Ошибка в наборе дат.');
WriteLn('Повторите ввод после нажатия ENTER');
ReadLn; Continue;
End;
End;
Write(fz,z);
Write('Продолжать ввод?..д/н..'); ReadLn(otv);
Until Not (otv In ['l','L','д','Д']);
Close(fz);
End;
{Поиск проживающего по фамилии}
Procedure Poisk_Fam(fname:String; famil:String);
Var
z:TZap;
otv:CHAR;
i:Word;
fz:TFZ;
Begin
If Not FileExist(fname)
Then Begin
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Файл ',fname,' не существует.');
WriteLn('Поиск записей невозможен.');
WriteLn('Нажмите ENTER.');
ReadLn; Exit;
End;
Okno(1,1,80,25,13,10,'');
ClrScr;
WriteLn('С фамилией ',famil,' в гостинице проживали:');
WriteLn;
WriteLn(' ',TEX_3);
Assign(fz,fname); Reset(fz);
i:=3;
While Not EOF(fz)
Do Begin
Read(fz,z);
If z.fam=famil
Then Begin
Inc(i);
With z Do
Begin
Write(' | ');
GoToXY(9,i); Write(fam);
GoToXY(25,i); Write('| ',nomer);
With data_pr Do
Begin
Write(' | ');
If dd<10 Then Write('0');
Write(dd,'.');
If mm<10 Then Write('0');
Write(mm,'.');
If gg<10 Then Write('0');
Write(gg);
End;
With data_ot Do
Begin
Write(' | ');
If dd<10 Then Write('0');
Write(dd,'.');
If mm<10 Then Write('0');
Write(mm,'.');
If gg<10 Then Write('0');
Write(gg);
End;
End;
WriteLn;
End;
If i=20
Then Begin
Write('Для продолжения нажмите ENTER');
ReadLn;
i:=0;
ClrScr;
End;
End;
WriteLn;
WriteLn('Для продолжения нажмите ENTER');
ReadLn;
Window(1,1,80,25);
TextBackGround(1);
ClrScr;
Close(fz);
End;
{Удаление записей}
Procedure Udal_Zap(fname:String);
Var
z:TZap;
otv:CHAR;
nomer:Word;
i:1..FLOOR;
j:1..APPART;
fz,fpr:TFZ;
pr:Boolean;
Begin
If Not FileExist(fname)
Then Begin
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Файл ',fname,' не существует.');
WriteLn('Удаление записей невозможно.');
WriteLn('Нажмите ENTER');
ReadLn; Exit;
End;
Okno(2,2,45,18,14,10,TEX_1);
ClrScr;
Repeat
Assign(fz,fname); Reset(fz);
WriteLn('Введите номер апартаментов для поиска:');
ReadLn(nomer);
i:=nomer Div 100;
j:=nomer-i*100;
If(i<1)Or(i>FLOOR)Or(j<1)Or(j>APPART)
Then Begin
WriteLn('Ошибка в указании номера');
WriteLn('Повторите ввод после нажатия ENTER');
ReadLn; Continue;
End;
Assign(fpr,'C:\pr.txt'); Rewrite(fpr);
pr:=TRUE;
Repeat
Read(fz,z);
If z.nomer=nomer
Then Begin
pr:=FALSE;
ClrScr;
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Производится удаление');
WriteLn('записи для апартаментов ',nomer);
Write('Подтвердите удаление д/н ->');
ReadLn(otv);
If (otv In['l','L','д','Д'])
Then Continue;
End;
Write(fpr,z);
Until EOF(fz);
Erase(fz);
Close(fpr);
Rename(fpr,fname);
Okno(46,2,80,18,13,10,TEX_2);
WriteLn('Корректировка закончена.');
If pr Then WriteLn('Запись не обнаружена.');
Write('Продолжать корректировку?.д/н.'); ReadLn(otv);
Until Not (otv In ['l','L','д','Д']);
Close(fz);
End;
{основная программа}
Var
fname:String;
z:TZap;
txt:String;
otv:Byte;
den:TData;
ch:Char;
familiya:String;
Begin
TextBackGround(1);
ClrScr;
Okno(2,2,45,18,14,10,TEX_1);
WriteLn('Выбор операции:1-создание файла');
WriteLn(' 2-поиск записей');
WriteLn(' 3-добавление записи');
WriteLn(' 4-удаление записи');
WriteLn(' 5-просмотр записей');
WriteLn(' 6-завершение работы');
ReadLn(otv);
Repeat
Case otv Of
1:Begin
ClrScr;
WriteLn('Введите имя создаваемого файла:');
ReadLn(fname);
SozdFZ(fname);
End;
2:Begin
ClrScr;
Write('Введите фамилию для поиска..');
ReadLn(familiya);
WriteLn('Введите имя существующего файла..');
ReadLn(fname);
Poisk_fam(fname,familiya);
End;
3:Begin
ClrScr;
WriteLn('Добавляем новые записи.');
WriteLn('Введите имя существующего файла..');
ReadLn(fname);
Dobavl(fname);
End;
4:Begin
ClrScr;
WriteLn('Удаление записи.');
WriteLn('Введите имя существующего файла..');
ReadLn(fname);
Udal_Zap(fname);
End;
5:Begin
ClrScr;
WriteLn('Введите имя существующего файла..');
ReadLn(fname);
WriteLn('Введите дату начала просмотра');
Write(' год.(гг)..'); ReadLn(den.gg);
Write('месяц.(мм)..'); ReadLn(den.mm);
Write(' день.(дд)..'); ReadLn(den.dd);
WriteLn('Нужна ли предварительная сортировка');
Write('записей по номерам апартаментов? д/н..');
ReadLn(ch);
If ch In['l','L','д','Д']
Then Sort_Fz(fname);
ProsmFz(fname,den);
End;
6:Begin
Okno(2,2,45,18,14,10,TEX_1);
WriteLn('Работа действительно заканчивается?');
Write('д/н..');
ReadLn(ch);
If ch In['l','L','д','Д']
Then Exit;
End;
End;
Window(1,1,80,25);
TextBackGround(1);
ClrScr;
Okno(2,2,45,18,14,10,TEX_1);
ClrScr;
WriteLn('Выбор операции:1-создание файла');
WriteLn(' 2-поиск записей');
WriteLn(' 3-добавление записи');
WriteLn(' 4-удаление записи');
WriteLn(' 5-просмотр записей');
WriteLn(' 6-завершение работы');
ReadLn(otv);
Until otv=6;
End.
Дата публикования: 2014-11-03; Прочитано: 283 | Нарушение авторского права страницы | Мы поможем в написании вашей работы!