Материал: Мансуров. Основы программирования в среде Lazarus. 2010

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;

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