Материал: Мансуров. Основы программирования в среде 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