Пример 2

Program Primer2_3_3_3;

{Сведения о багаже авиапассажира состоят из фамилии, имени, отчества, количества вещей, общего веса багажа и признака наличия фотоаппаратуры. Сведения хранятся в текстовом файле. Вывести в другой текстовый файл фамилии, имена, отчества пассажиров, имеющих фотоаппаратуру. Кроме того, вывести на экран число пассажиров, вес багажа которых превышает 20 кг, и число пассажиров, у которых средний вес одной вещи больше 15 кг.}

Type Bagpas=Record{тип Bagpas - это запись, содержащая сведения о багаже одного пассажира}

Fio:String; {ФИО пассажира}

Kv: integer; {количество вещей пассажира}

P:Real; {вес багажа}

Foto:integer; {Foto=1, если фотоапаратура есть;

Foto=0, в противном случае}

End;

Var Pas:Bagpas; {cведения о багаже одного пассажира}

NameF:array [1..20] of string;

{массив ФИО пассажиров, имеющих фото}

Nf:integer; {число пассажиров, имеющих фото}

N20:integer;{число пассажиров, вес багажа которых больше 20 кг}

N15:Integer;

{число пассажиров, у которых средний вес вещи больше 15 кг}

i:Integer; { счетчик пассажиров}

F,G:text;

Begin

Assign(F,'d:\student\bag');

Reset(F);

Assign(G,'d:\student\fotores');

Rewrite(G);

If eof (F) then

Writeln (' Пуст файл исходных данных')

Else

Begin

Nf:=0; N20:=0;N15:=0;

While not eof(F) do

With pas do

Begin

Readln(F,Fio);

Readln(F,Kv);

Readln(F, P);

Readln(F,Foto);

If Foto=1 then

Begin

Nf:=Nf+1;

Writeln(G,Fio);

End;

If P>20 Then N20:= N20+1;

If P/Kv>15 Then N15:=N15+1;

End;

If Nf=0 Then Writeln(' Пассажиров с фотоаппаратурой нет')

Else

Begin

Writeln(

' Фамилии пассажиров с фотоаппаратурой в файле foto');

End;

Writeln(' Багаж больше 20 кг у',N20:3,' пассажиров');

Writeln(' Cредний вес одной вещи больше 15 кг у', N15:3,' пассажиров');

End;

Close(F);

Close(G);

End.

Замечание.Текстовые файлы можно ввести в ЭВМ, прочитать, исправить с помощью текстового редактора.

3.3.4. Типизированные файлы

Описание типизированного файла:

VAR Имя Файла:FILE OF Базовый Тип; . . .

Базовый тип - любой, но не файл.

Процедуры чтения из файла и записи в файл:

READ (Имя Файла,Список Переменных)

WRITE(Имя Файла,Список Переменных)

Cписок переменных содержит переменные только базового типа.

Операторы READLN и WRITELN не имеют смысла, так как компоненты файла не являются строками.

Напомним, что типизированные файлы хранят данные во внутреннем представлении, поэтому их нельзя подготовить с помощью текстового редактора. Для записи значений в типизированный файл и чтения типизированного файла необходимо подготовить специальные программы, как показано в примере.

Пример 1. Рассматриваются данные об игрушках из примеров §§3.1.3, 3.2, 3.3.3. Приведенные три программы должны работать последовательно друг за другом.

program texttyp {пpеобpазование текст.файла в типизиpованный};

type sved=record

name:string;

minage,maxage:integer;rub:real;

end;

var xtext:text; x:file of sved; toy:sved;

Begin Assign(xtext,'G:\valia\xtext'); Assign(x,'G:\valia\x');

{xtextготовится в текстовом редакторе, х получается программно}

reset(xtext);rewrite(x);

if eof(xtext) then writeln(' Исходный текстовый файл пуст')

else

Begin

while not eof(xtext) do

Begin

with toy do

Begin

readln(xtext,name);

readln(xtext,minage,maxage,rub);

End;

write(x,toy);

End;

End;

Close(x); Close(xtext);

End.

program TypFile;

{из типизированного файла хв типизиpован. файлyзаписываются }

{ сведения о констpуктоpах для детей до семи лет}

Type sved=record

name:string;

minage,maxage:integer;rub:real;

end;

Var x,y:file of sved; toy:sved;

Begin

Assign (x,'g:\valia\x');

Assign(y,'g:\valia\y');

reset(x); rewrite(y);

if eof(x) then writeln('x - пустой файл')

else

Begin

while not eof(x) do

Begin read(x,toy);{считывается запись полностью}

with toy do

if ((pos('констpуктоp',name)>0) or

(pos('Констpуктоp',name)>0))

and (maxage<=7) then

write(y,toy);

End;

End;

Close(x); Close(y);

End.

program typtext; {перевод типизированного файла в текстовый}

type sved=record

name:string;

minage,maxage:integer;rub:real;

End;

Var y:file of sved; ytext:text; toy:sved;

Begin Assign(y,'G:\valia\y'); Assign(ytext,'G:\valia\ytext');

reset(y);rewrite(ytext);

if eof(y) then writeln(' типизированный файл пуст')

else

Begin

while not eof(y) do

Begin

read(y,toy);

With toy do

Begin

writeln(ytext,name);

writeln(ytext,minage,maxage,rub:7:0);

End;

End;

End;

Close(y); Close(ytext);

End.

Замечание. В типизированном файле все компоненты занимают одинаковое количество байтов памяти, поэтому можно определить адрес начального байта каждой компоненты по её номеру. Подпрограммы, использующие эту возможность, называются подпрограммами прямого доступа. Они приведены ниже.

Функция FILESIZE(ИмяФайла) возвращает число компонент файла.

Функция FILEPOS(ИмяФайла) возвращает номер компоненты, которая будет обрабатываться следующей процедурой ввода-вывода.

Процедура SEEK(ИмяФайла, №компоненты) смещает указатель к требуемой компоненте.

Компоненты файла нумеруются с нуля. Следовательно, оператор SEEK(ИмяФайла,FILESIZE(ИмяФайла)) переместит указатель к концу файла.

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

Пример 2. Приведенная ниже программа заменяет в типизированном файле целых чисел нулевые значения на значениеa, задаваемое вводом. Для подготовки типизированного файла и его просмотра требуется написать программы, аналогичныеTextTypиTypTextпримера 1.

program Project1;

Var F:file of integer; a,b:integer;

begin

AssignFile(f, 'ftyp');{файл ftyp поготовлен с помощью}

Reset(F); {специальной программы}

Ifeof(F)then

writeln (' File is empty')

else

Begin

writeln('Input a');

readln(a);

while not eof(F) do

begin

read(F,b);

if b=0 then

begin

seek(F,filepos(F)-1);{возврат к компоненте, равной 0}

write(F,a){замена нулевого значения на а}

end

end;

CloseFile(F); writeln('end');

End;Readln

end.

Совет: не стоит использовать процедуры прямого доступа при последовательной записи или последовательном считывании компонент, это увеличит время работы программы.