Пример программы. {Разработать программу, создающую файл записей, содержащий

{Разработать программу, создающую файл записей, содержащий

информацию о проживающих в гостиничном комплексе (фамилия,

занимаемый номер, дата приезда, дата отъезда). Реализовать

процедуры добавления новых записей, поиска по фамилии, вывода

информации начиная с конкретной даты, удаление записей,

сортировки файла по возрастанию номеров апартаментов.}

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.