Мансуров. Основы программирования в среде Lazarus. 2010
.pdfГлава 3 Более сложные элементы языка
____________________________________________________________________
3-го параметра процедуры записи/чтения} BlockWrite(matrix, temp, SizeOf(real));
end;
writeln(UTF8ToConsole('Информация на диск записана')); CloseFile(matrix);
writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;
end.
Программа решения системы линейных алгебраических уравнений мето-
дом Гаусса, коэффициенты расширенной матрицы вводятся из нетипизирован-
ного файла:
program Gauss_File; {$mode objfpc}{$H+} uses
CRT, FileUtil; var
matrix: File;
a:array of array of real; {матрица коэффициентов системы, двумерный динамический массив}
vector: array of real; {преобразованный одномерный динамический массив}
b:array of real;
x: array of real; temp: real;
i, j, k, n: integer; {Процедура остается без изменений}
procedure gauss(var vector: array of real; var b: array of real;
var x: array of real; var n: integer);
var
a: array of array of real; {матрица коэффициентов системы, двумерный динамический массив}
i, j, k, p, r: integer; m, s, t: real;
begin
SetLength(a, n, n); // установка фактического размера массива
251
3.6 Файлы
____________________________________________________________________
{Преобразование одномерного массива в двумерный} k:=1;
for i:=0 to n-1 do for j:=0 to n-1 do begin
a[i,j]:= vector[k]; k:=k+1;
end;
for k:=0 to n-2 do begin
for i:=k+1 to n-1 do begin
if (a[k,k]=0) then begin
{перестановка уравнений}
p:=k; // в алгоритме используется буква l, но она похожа на 1 // Поэтому используем идентификатор p
for r:=i to n-1 do begin
if abs(a[r,k]) > abs(a[p,k]) then p:=r; end;
if p<>k then begin
for j:= k to n-1 do begin
t:=a[k,j];
a[k,j]:=a[p,j];
a[p,j]:=t;
end;
t:=b[k];
b[k]:=b[p];
b[p]:=t;
end;
end; // конец блока перестановки уравнений m:=a[i,k]/a[k,k];
a[i,k]:=0;
for j:=k+1 to n-1 do begin
a[i,j]:=a[i,j]-m*a[k,j]; end;
b[i]:= b[i]-m*b[k]; end;
end;
252
Глава 3 Более сложные элементы языка
____________________________________________________________________
{Проверка существования решения} if a[n-1,n-1] <> 0 then begin
x[n-1]:=b[n-1]/a[n-1,n-1]; for i:=n-2 downto 0 do begin
s:=0;
for j:=i+1 to n-1 do begin
s:=s-a[i,j]*x[j]; end;
x[i]:=(b[i] + s)/a[i,i]; end;
writeln(''); writeln(UTF8ToConsole('Решение:')); writeln('');
for i:=0 to n-1 do
writeln('x', i+1, '= ', x[i]:0:4);
end else
if b[n-1] = 0 then writeln(UTF8ToConsole('Система не имеет решения.'))
else
writeln(UTF8ToConsole('Система уравнений'+ ' имеет бесконечное множество решений.'));
writeln(''); {освобождение памяти,
распределенной для динамического массива} a:=nil;
end;
{Начало основной программы} begin
AssignFile(matrix, 'Coeff.dat'); Reset(matrix, 1);
{Чтение количества уравнений системы из файла} BlockRead(matrix, n, SizeOf(integer)); {Установка реальных размеров динамических массивов} SetLength(a, n, n);
SetLength(vector, n*n); SetLength(b, n); SetLength(x, n);
{Ввод коэффициентов расширенной матрицы} for i:=1 to n do
253
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