3.6 Файлы

____________________________________________________________________

begin

for j:=1 to n do begin

BlockRead(matrix, temp, SizeOf(real)); a[i-1, j-1]:= temp;

end;

BlockRead(matrix, temp, SizeOf(real)); b[i-1]:= temp;

end;

{Преобразование двумерного массива в одномерный} k:=1;

for i:=0 to n-1 do for j:=0 to n-1 do begin

vector[k]:=a[i,j];

k:=k+1;

end;

CloseFile(matrix);

{Вызов процедуры решения системы линейных алгебраических уравнений методом Гаусса} gauss(vector, b, x, n); {освобождение памяти, распределенной для динамических массивов}

a:=nil;

vector:=nil;

x:=nil;

b:=nil;

writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;

end.

3.6.3.5. Организация контроля ввода/вывода при работе файлами

При работе с файлами часто возникают непредвиденные ситуации, кото-

рые приводят к ошибкам ввода/вывода. Такие ситуации возникают, например,

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

грамма аварийно завершается. Паскаль предоставляет возможность ввести в

программу контроль операций ввода/вывода. Это дает возможность даже если

254

Глава 3 Более сложные элементы языка

____________________________________________________________________

не исправить сразу возникшую ошибку, то хотя бы локализовать ее, вывести какое-то сообщение или предупреждение и продолжить работу с программой.

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

томатический контроль операций ввода/вывода директивой компилятора

{$I-}. Этой директивой программа как бы сообщает компилятору и операци-

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

вершения очередной операции ввода/вывода функция возвращает 0, если опе-

рация прошла успешно. В противном случае функция возвращает код ошибки.

Необходимо анализировать значение функции IOResult сразу после вво-

да/вывода. В противном случае функция сбрасывает свое значение в 0. После завершения опасного участка программы, автоматический контроль вво-

да/вывода нужно восстановить директивой компилятора {$I+}.

Рассмотрим пример. Пусть имеется текстовый файл Data.txt. В про-

грамме моделируется ситуация, когда пользователь записывает в файл последо-

вательности целых чисел в их символьном представлении. Затем программа чи-

тает эти числа в переменную целого типа. В первый раз пользователь вводит строку '1234', во второй раз пользователь случайно ввел вместо цифры недо-

пустимый для числа символ, например вводит строку '12#4', т.е. нажал на клавишу с цифрой 3 в верхнем регистре.

program project1; {$mode objfpc}{$H+} uses

CRT, FileUtil, SysUtils; var

F: TextFile; code: word; number:integer;

255

3.6 Файлы

____________________________________________________________________

s:string; begin

AssignFile(F, 'Data.txt');

Rewrite(F);

s:='1234'; Writeln(F, s); s:='12#4'; Writeln(F, s); Reset(F);

while not Eof(F) do begin

{$I-}

Readln(F, number); {$I+}

code:= IOResult; if code<>0 then begin

writeln(UTF8ToConsole('Ошибка преобразования типов, ')); writeln(UTF8ToConsole('код ошибки '), code);

break end;

writeln('number= ', number);

end;

CloseFile(F);

writeln(UTF8ToConsole('Нажмите любую клавишу'));

readkey;

end.

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

ние целого числа number=1234. При чтении второй строки файла происходит

256

Глава 3 Более сложные элементы языка

____________________________________________________________________

ошибка преобразования строки символов в целое число, о чем программа и со-

общает пользователю.

Для проверки существования файла удобнее пользоваться функцией

FileExists(fname), где fname имя файла – строка символов. В сле-

дующем фрагменте программе проверяется существование файла на диске. Ес-

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

if not FileExists('My_file.txt') then

Rewrite(kol)

else

Reset(kol);

3.6.3.6. Создание простой базы данных с типизированными файлами.

Рассмотрим пример разработки достаточно большой и сложной програм-

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

туры, процедуры и функции, контроль операций ввода/вывода. Освоим технику создания и работы с меню. Фактически создается небольшая и простенькая база данных. Чтобы не загромождать текст программы многочисленными проверка-

ми в программу введены процедуры Reset_file, Read_File и Write_File внутри которых и производится контроль правильности опера-

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

Фамилия	Группа	Предмет	Оценка

program Database_Student; {$mode objfpc}{$H+}

257

3.6 Файлы

____________________________________________________________________

uses

CRT, FileUtil, SysUtils, LConvEncoding, LCLType;

type
student = record	{тип запись}
fio: string[24];	// фамилия

predmet: string[32]; // предмет gruppa: string[24]; // группа ocenka: integer;

end;

fstud = File of student;

var

fam: string[24]; // фамилия sub: string[32]; // предмет gr: string[24]; // группа

answ: TUTF8Char; // символ для приема ответа пользователя f, v: fstud; {f,v - файловые переменные,

где f - имя основного файла;

v - имя вспомогательного файла} new_student: student;

choice,choose, ocen: integer; {переменные,

предназначенные для выбора режима} fname: string; {строковая переменная, имя файла на диске без расширения}

full_fname: string; {строковая переменная,

полное имя файла на диске с расширением} code_error: integer; // код ошибки ввода/вывода

// опережающее объявление функций и процедур procedure Reset_File( var f: fstud); forward; procedure Read_File(var f: fstud;

var st: student); forward; procedure Write_File(var f: fstud;

var st: student); forward; procedure check_file; forward;

{ ================ Ввод данных ================ } procedure input_data;

begin

with new_student do begin

258

Глава 3 Более сложные элементы языка

____________________________________________________________________

writeln(UTF8ToConsole(' Фамилия ')); readln(fio); writeln(UTF8ToConsole(' Группа ')); readln(gruppa); writeln(UTF8ToConsole(' Предмет ')); readln(predmet); writeln(UTF8ToConsole(' Оценка ')); repeat

{$I-} readln(ocenka); {$I+}

if (IOResult <> 0) or ((ocenka > 5) or (ocenka < 1)) then

begin

writeln(UTF8ToConsole('Введите целое число от 1 до 5')); end;

until (ocenka >= 1) and (ocenka <= 5); end;

end;

{ ================ Создание файла ================ } procedure create_data;

begin check_file; Rewrite(f);

writeln(UTF8ToConsole(' Введите данные ')); repeat

input_data;

Write(f, new_student);

writeln(UTF8ToConsole(' Продолжить?, ответ - д/н (y/n) ')); readln(answ);

{$IFDEF WINDOWS}

answ:= CP866ToUTF8(answ); {$ENDIF}

until (answ='N') or (answ='n') or (answ='н') or (answ= 'Н');

end;

procedure check_file; var

answ: TUTF8char; begin

if FileExists(full_fname) then begin

259

3.6 Файлы

____________________________________________________________________

Assign(f, full_fname); Reset(f);

writeln(UTF8ToConsole('Текущий файл будет уничтожен!!')); writeln(UTF8ToConsole('Чтобы стереть существующий ')); writeln(UTF8ToConsole('файл, нажмите клавишу Esc,')); writeln(UTF8ToConsole('иначе нажмите любую клавишу.')); repeat

answ:= readkey;

if answ= #27 then begin

writeln(UTF8ToConsole('Вы уверены? Нажмите ')); writeln(UTF8ToConsole('еще раз клавишу Esc')); writeln(UTF8ToConsole('Для отмены нажмите ')); writeln(UTF8ToConsole('любую клавишу.')); answ:= readkey;

if answ = #27 then break;

end;

writeln(UTF8ToConsole('Введите другое имя файла')); CloseFile(f);

readln(fname);

Assign(f, fname +' .dat'); break;

until answ = #27; end;

end;

{ ================ Вывод содержимого файла ================ } procedure out_to_screen;

var j: integer; begin

Reset_File(f); ClrScr; GoToXY(1, 5); j:= 0;

writeln(UTF8ToConsole('*фамилия * группа * предмет*оценка *')); wri-

teln('==============================================='); while not Eof(f) do

begin read(f,new_student); j:= j + 1; GoToXY(2, 6 + j);

260

Глава 3 Более сложные элементы языка

____________________________________________________________________

writeln(new_student.fio); GoToXY(15, 6 + j); writeln(new_student.gruppa); GoToXY(28, 6 + j); writeln(new_student.predmet); GoToXY(48, 6 + j); writeln(new_student.ocenka);

end; wri-

teln('==============================================='); writeln(UTF8ToConsole(' Число студентов='),j:2); writeln(UTF8ToConsole('Нажмите любую клавишу ')); readkey;

end;

{ ========= Поиск записей по заданным полям ============ }

procedure select_data;
begin
repeat
Reset_File(f);
ClrScr;
GoToXY(10, 10);
write	(UTF8ToConsole('Выбор информации по:'));
GoToXY(10, 11);
write	(UTF8ToConsole(' группе	- 1'));
GoToXY(10, 12);
write	(UTF8ToConsole(' предмету	- 2'));
GoToXY(10, 13);
write	(UTF8ToConsole(' оценке	- 3'));

GoToXY(10, 14);

writeln(UTF8ToConsole(' выход из режима - 4')); readln(choice);

ClrScr;

case choice of 1: begin

write(UTF8ToConsole(' Группа -')); readln(gr);

writeln(UTF8ToConsole(' Сведения по группе '), UTF8ToConsole(gr):5);

end; 2: begin

write(UTF8ToConsole(' Предмет -')); readln(sub);

261

3.6 Файлы

____________________________________________________________________

writeln(UTF8ToConsole(' Сведения по предмету '), UTF8ToConsole(sub):15);

end; 3: begin

write(UTF8ToConsole(' Оценка =')); readln(ocen);

writeln(UTF8ToConsole(' Сведения по оценке '), ocen:1);

end;

else exit;

end; { end of case } while not eof(f) do begin

Read_File(f,new_student); case choice of

1:if new_student.gruppa=gr then writeln(new_student.fio:15,

'',new_student.predmet:15,

'',new_student.ocenka:1);

2:if new_student.predmet=sub then writeln(new_student.fio:15,

'',new_student.gruppa:15,

'',new_student.ocenka:1);

3:if new_student.ocenka=ocen then writeln(new_student.fio:15,

'',new_student.predmet:15,

'',new_student.gruppa:5);

end; { end of case } end; { end of while } GoToXY(5, 24);

writeln(UTF8ToConsole('Нажмите любую клавишу ')); readkey;

until choice = 4; end;

{ ======== Восстановление файла под основное имя f ========== } procedure restorefile;

begin CloseFile(f); CloseFile(v); Erase(f); Rewrite(f);

262

Глава 3 Более сложные элементы языка

____________________________________________________________________

Reset(v);

while not Eof(v) do begin

Read_File(v, new_student); Write_File(f, new_student);

end;

CloseFile(f); CloseFile(v); Erase(v);

{удален вспомогательный файл v под внешним именем s.dat} end;

{================ Добавление записей в файл ================}

procedure add_data; begin

Assign(v, 's.dat'); Rewrite(v);

{"s.dat" - имя вспомогательного файла} Reset_File(f);

{копирование содержимого файла f в файл v } while not Eof(f) do

begin

Read_File(f, new_student); Write_File(v, new_student);

end;

writeln(UTF8ToConsole(' Вводите информацию ')); { записи добавляются в конце файла }

repeat input_data;

Write_File(v, new_student);

writeln(UTF8ToConsole(' Продолжить?, ответ - д/н (y/n) ')); readln(answ);

{$IFDEF WINDOWS}

answ:= CP866ToUTF8(answ); {$ENDIF}

until (answ='N') or (answ='n') or (answ='н') or (answ= 'Н');

restorefile;

end;

{================ Удаление записей из файла ================}

procedure delete_data; begin

Assign(v, 's.dat'); Rewrite(v); Reset(f); ClrScr;

263

3.6 Файлы

____________________________________________________________________

GoToXY(10, 10);

writeln(UTF8ToConsole('Удаление информации по:')); GoToXY(10, 11);

writeln(UTF8ToConsole(' группе	- 1'));
GoToXY(10, 12);
writeln(UTF8ToConsole(' фамилии	- 2'));
GoToXY(10, 13);
writeln(UTF8ToConsole(' предмету	- 3'));
GoToXY(10, 14);
writeln(UTF8ToConsole(' оценке	- 4'));
GoToXY(10, 15);

writeln(UTF8ToConsole(' выход из режима - 5')); GoToXY(10, 16);

write(UTF8ToConsole(' выбор режима =')); readln(choice);

case choice of 1: begin

write(UTF8ToConsole(' Группа - ')); readln(gr);

end; 2: begin

write(UTF8ToConsole(' Фамилия - ')); readln(fam);

end; 3: begin

write(UTF8ToConsole(' Предмет - ')); readln(sub);

end; 4: begin

write(UTF8ToConsole(' Оценка - ')); readln(ocen);

end;

5: exit; { выход в основную программу } end; { end of case }

{========= поиск записи для удаления =========== } while not Eof(f) do

begin

Read_File(f, new_student);

case choice of

1: if new_student.gruppa<>gr then Write_File(v,new_student);

264

Глава 3 Более сложные элементы языка

____________________________________________________________________

2:if new_student.fio<>fam then Write_File(v,new_student);

3:if new_student.predmet<>sub then Write_File(v,new_student);

4:if new_student.ocenka<>ocen then

Write_File(v,new_student); else

begin

writeln(UTF8ToConsole(' Ошибка при вводе ')); writeln(UTF8ToConsole('Нажмите любую клавишу ')); readkey;

end;

end; { end of case } end; { end of while } restorefile;

end;

{======== процедура открытия файла с контролем операции ======== } procedure Reset_File( var f:fstud);

begin {$I-} Reset(f); {$I+}

code_error:= IOResult; if code_error <> 0 then begin

writeln(UTF8ToConsole('Файл не существует, код ошибки '), code_error);

writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;

Halt;

end;

end;

{========== процедура чтения с контролем операции ============}

procedure Read_File(var f: fstud; var st: student); begin

{$I-} Read(f, st); {$I+}

code_error:= IOResult; if code_error <> 0 then begin

265

3.6 Файлы

____________________________________________________________________

writeln(UTF8ToConsole('Ошибка чтения, код ошибки '), code_error);

writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;

Halt;

end;

end;

{========== процедура записи с контролем операции ============}

procedure Write_File(var f: fstud; var st: student); begin

{$I-} Write(f, st); {$I+}

code_error:= IOResult; if code_error <> 0 then begin

writeln(UTF8ToConsole('Ошибка записи в файл, код ошибки '), code_error);

writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;

Halt;

end;

end;

{ ============== корректировка записей в файле ============== } procedure find_data;

var r: student; begin

Reset_File(f); Assign(v,'s.dat'); Rewrite(v); ClrScr;

GoToXY(10, 9);

writeln(UTF8ToConsole('Укажите ключ (поле) для поиска')); GoToXY(10, 10); writeln(UTF8ToConsole('корректируемой записи - по:')); GoToXY(10, 11);

writeln(UTF8ToConsole(' группе	- 1'));
GoToXY(10, 12);
writeln(UTF8ToConsole(' фамилии	- 2'));
GoToXY(10, 13);
writeln(UTF8ToConsole(' предмету	- 3'));
GoToXY(10, 14);
writeln(UTF8ToConsole(' оценке	- 4'));
GoToXY(10, 15);

266

Глава 3 Более сложные элементы языка

____________________________________________________________________

writeln(UTF8ToConsole(' выход из режима - 5')); GoToXY(10, 16);

write(UTF8ToConsole(' выбор режима =')); readln(choice); ClrScr;

GoToXY(10, 9);

writeln(UTF8ToConsole(' Замена информации ')); case choice of { поиск записи }

1: begin

GoToXY(10, 10); write(UTF8ToConsole('группа=')); readln(gr);

input_data; end;

2: begin GoToXY(10, 10);

write(UTF8ToConsole('фамилия=')); readln(fam);

input_data; end;

3: begin GoToXY(10, 10);

write(UTF8ToConsole('предмет=')); readln(sub);

input_data; end;

4: begin GoToXY(10, 10);

write(UTF8ToConsole('оценка=')); readln(ocen);

input_data; end;

5: exit; { выход в основную программу } end; { end of case }

while not Eof(f) do begin

Read_File(f, r); case choice of

1: begin

if gr=r.gruppa then Write_File(v,new_student)

else Write_File(v,r)

end;

267

3.6 Файлы

____________________________________________________________________

2: begin

if fam=r.fio then Write_File(v,new_student)

else Write_File(v,r)

end; 3: begin

if sub=r.predmet then Write_File(v,new_student)

else Write_File(v,r)

end; 4: begin

if ocen=r.ocenka then Write_File(v,new_student)

else Write_File(v,r)

end;

end; { end of case } end; { end of while } restorefile;

end;

{ ============== основная программа ===================}

begin

writeln(UTF8ToConsole('Введите имя файла:')); readln(fname);

{$IFDEF WINDOWS} fname:=CP866ToUTF8(fname); fname:=UTF8ToAnsi(fname);

{$ENDIF}

full_fname:=fname + '.dat'; Assign(f,full_fname); repeat

ClrScr;

{ Формирование меню работы с основным файлом f } GoToXY(10, 7);

writeln(UTF8ToConsole('Выберите нужный режим работы :')); GoToXY(10, 8);

writeln(UTF8ToConsole('Создание файла	1'));
GoToXY(10, 9);
writeln(UTF8ToConsole('Вывод содержимого файла	2'));
GoToXY(10, 10);
writeln(UTF8ToConsole('Поиск по заданным полям	3'));

268

Глава 3 Более сложные элементы языка

____________________________________________________________________

GoToXY(10, 11);
writeln(UTF8ToConsole('Добавление записей в файл	4'));
GoToXY(10, 12);
writeln(UTF8ToConsole('Удаление записей из файла	5'));
GoToXY(10, 13);
writeln(UTF8ToConsole('Корректировка записей в файле	6'));
GoToXY(10, 14);
writeln(UTF8ToConsole('Выход из программы	7'));
readln(choose);
case choose of

{choose - значение для выбора режима работы с файлом f }

1:create_data;

2:out_to_screen;

3:select_data;

4:add_data;

5:delete_data;

6:find_data;

end; { end of case } until choose=7;

end.

В этой программе новым для нас является только опережающее объявле-

ние функций и процедур. В Паскале строго соблюдается правило – каждый объект перед использованием должен быть описан. Что касается функций и процедур, то здесь сделаны некоторые "поблажки". Пусть имеются две проце-

дуры, одна из которых вызывает другую.

procedure A (param: integer;)

begin

. . . . .

B(i);

. . . . .

end;

procedure B(param: integer);

begin

. . . . .

269

3.6 Файлы

____________________________________________________________________

end;

При таком расположении и таком описании процедур компилятор выдаст ошибку "Identifier not found "B"". Можно конечно переставить местами эти процедуры, но можно сделать так называемое опережающее описание про-

цедуры таким вот образом:

procedure B(param: integer); forward; procedure A (param: integer;)

begin

. . . . .

B(i);

. . . . .

end;

procedure B(param: integer); begin

. . . . .

end;

Как видим, опережающее описание заключается в том, что объявляется лишь заголовок процедуры В, а тело процедуры заменяется директивой forward. Теперь в процедуре А можно использовать обращение к процедуре

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

компилятор может правильным образом организовать ее вызов.

Рассмотрим другую ситуацию. Предположим, что процедуры А и В вызы-

вают друг друга:

procedure A (param: integer;)

begin

. . . . .

270

Глава 3 Более сложные элементы языка

____________________________________________________________________

B(i);

. . . . .

end;

procedure B(param: integer);

begin

. . . . .

A(i);

. . . . .

end;

Теперь не поможет и перестановка местами процедур, так как они "зацик-

лены" друг на друга. Только использование опережающего объявления проце-

дуры В позволяет разрешить эту проблему.

procedure B(param: integer); forward; procedure A (param: integer;)

begin

. . . . .

B(i);

. . . . .

end;

procedure B(param: integer); begin

. . . . .

A(i);

. . . . .

end;

271