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

Глава 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;

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

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(' выход из режима - 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);

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);

268

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

____________________________________________________________________

{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