Изменение записи

procedure change(var f: file_typ); изменение

var s: stadt; k: integer; c: char;

begin

writeln('Какую запись изменить? ');

writeln('Задайте код: ');

readln(k);

reset(f);

while not eof(f) and (s.key< > k) do

read(f, s);

if s.key = k then

begin

s_geben(s); вывод старого содержимого полей текущей записи

write('Новое число жителей: ');

readln(s.ein);

s_geben(s); вывод нового содержимого полей

writeln('Все правильно? Д/Н');

readln(c);

case c of 'Д', 'д', 'L', 'l':

begin

seek(f, filepos(f)-1); переход на запись, номер которой

write(f, s); указан вторым аргументом. т.к. указатель

end; установлен на следующую запись, то нужно предварительно

end; вернуться назад

end

else

begin

write('Город с кодом', k: 6);

writeln(' не найден');

writeln('< Enter> '); read(c);

end;

close(f);

end;

Просмотр

procedure d_geben(var f: file_typ);

var s: stadt;

begin процедура просмотра содержимого файла

reset(f); открытие существующего файла (типизированного

while not eof(f) do для записи и чтения)

begin

read(f, s); читаем

s_geben(s); отображаем

end;

end;

//8-открытие файлов

procedure ber; Процедура для связывания логичских и физических имен файлов и открытия основного файла, если он новый

var c: char;

begin

assign(kop, 'temp.cop');

write('Имя файла? ');

readln(n);

{$I-}

assign(f, n);

writeln('Файл ', n, ' существует? Д/Н');

readln(c);

case c of

'Н', 'н', 'Y', 'y':

begin

rewrite(f);

close(f);

end

else

begin

Reset(f);

{$I+}

if IOResult < > 0 then

begin

Writeln('Ошибка открытия файла');

Halt(1); останов программы. Выход в ОС

end;

Close(f);

end;

end;

end;

Меню

procedure menue;

var c: char;

begin

clrscr;

quit: =false;

writeln('Что будете делать? ');

highvideo; write('У');

lowvideo; writeln('даление');

highvideo; write('Д');

lowvideo; writeln('обавление');

highvideo; write('И');

lowvideo; writeln('зменение');

highvideo; write('П');

lowvideo; writeln('росмотр');

highvideo; write('В');

lowvideo; writeln('ыход');

highvideo;

read(c);

case c of

'Д', 'д', 'l', 'L': append(f);

'У', 'у', 'e', 'E': delete(f);

'И', 'и', 'b', 'B': change(f);

'П', 'п', 'g', 'G': begin

d_geben(f);

writeln('< Enter> ');

readln(c);

end;

'В', 'в', 'd', 'D': quit: =true;

end

end;

begin

ber;

repeat (1) Главная программа

menue;

until quit;

end.

program gorod;

uses crt;

type stadt=record key: Integer;

name: string[20];

ein: longint;

kfz: string[3];

end;

file_typ = file of stadt;

var kop, f: file_typ;

n: string[20];

quit: boolean;

procedure lesen(var s: stadt);

begin

clrscr;

writeln('Конец ввода: код = 0');

write('Код: '); readln(s.key);

if s.key < > 0 then

begin

write('Название: '); readln(s.name);

write('Жителей: '); readln(s.ein);

write('Автомобилей: '); readln(s.kfz);

end;

end;

procedure s_geben(s: stadt);

begin

writeln(s.key: 4, s.name: 22, s.ein: 9, s.kfz: 5);

end;

procedure d_geben(var f: file_typ);

var s: stadt;

begin

reset(f);

while not eof(f) do

begin

read(f, s);

s_geben(s);

end;

end;

procedure ber;

var c: char;

begin

assign(kop, 'temp.cop');

write('Имя файла? ');

readln(n);

{$I-}

assign(f, n);

writeln('Файл ', n, ' существует? Д/Н');

readln(c);

case c of

'Н', 'н', 'Y', 'y':

begin

rewrite(f);

close(f);

end

else

begin

Reset(f);

{I+}

if IOResult < > 0 then

begin

Writeln('Ошибка открытия файла');

Halt(1);

end;

Close(f);

end;

end;

end;

procedure delete(var f: file_typ);

var s: stadt;

k: integer;

c: char;

found: boolean;

begin

writeln('Какую запись удалить? ');

writeln('Задайте код: ');

readln(k);

reset(f);

rewrite(kop);

found: =false;

while not eof(f) do

begin

read(f, s);

if s.key < > k then write(kop, s)

else

begin

found: =true;

s_geben(s);

write('Именно эту запись');

writeln(' удалить? Д/Н');

readln(c);

case c of

'Д', 'д', 'L', 'l':

else write(kop, s)

end;

end;

end;

close(f); close(kop);

if not found then

begin

write('Город с кодом ', k: 6);

write(' не найден.');

erase(kop);

writeln('< Enter> '); read(c);

end

else

begin

erase(f);

rename(kop, n);

assign(kop, 'temp.cop');

end;

end;

procedure FileSort(var f: file_typ);

var

s, s1: Stadt;

i, j: Longint;

begin

Reset(f);

for i: =FileSize(f)-1 downto 1 do

for j: =0 to i-1 do

begin

Seek(f, j);

Read(f, s, s1);

if s.key > s1.key then

begin

Seek(f, j);

Write(f, s1, s);

end;

end;

Close(f);

end;

procedure append(var f: file_typ);

var s: stadt; c: char;

begin

reset(f);

seek(f, filesize(f));

lesen(s);

writeln;

s_geben(s);

writeln('Все правильно? Д/Н');

readln(c);

case c of

'Д', 'д', 'L', 'l': write(f, s)

end;

close(f);

end;

procedure change(var f: file_typ);

var s: stadt; k: integer; c: char;

begin

writeln('Какую запись нужно изменить? ');

writeln('Задайте код: ');

readln(k);

reset(f);

while not eof(f) and (s.key< > k) do

read(f, s);

if s.key = k then

begin

s_geben(s);

write('Новое число жителей: ');

readln(s.ein);

s_geben(s);

writeln('Все правильно? Д/Н');

readln(c);

case c of 'Д', 'д', 'L', 'l':

begin

seek(f, filepos(f)-1);

write(f, s);

end;

end;

end

else

begin

write('Город с кодом', k: 6);

writeln(' не найден');

writeln('< Enter> '); read(c);

end;

close(f);

end;

procedure menue;

var c: char;

begin

clrscr;

quit: =false;

writeln('Что будете делать? ');

highvideo; write('У');

lowvideo; writeln('даление');

highvideo; write('Д');

lowvideo; writeln('обавление');

highvideo; write('И');

lowvideo; writeln('зменение');

highvideo; write('П');

lowvideo; writeln('росмотр');

highvideo; write('В');

lowvideo; writeln('ыход');

highvideo;

read(c);

case c of

'Д', 'д', 'l', 'L': begin

append(f);

FileSort(f);

end;

'У', 'у', 'e', 'E': begin

delete(f);

end;

'И', 'и', 'b', 'B': begin

change(f);

end;

'П', 'п', 'g', 'G': begin

d_geben(f);

writeln('< Enter> ');

readln(c);

end;

'В', 'в', 'd', 'D': quit: =true;

end

end;

begin

ber;

repeat

menue;

until quit;

end.

Не все ошибки обрабатываем: сказали, что файла нет, а сами можем выйти на удаление.

Еще пример, но работаем с двумя файлами (очень простой).

Пример работы с двумя файлами: справочником (редко изменяемая информация) и основным(оперативная информация).

Задача:

Организовать работу по вводу и выводу информации о сотрудниках:

1) ввести файл-справочник и основной файл.

2) вывести на экран таблицу следующего вида:

фамилия, название должности, зарплата.

Файл справочник: код должности (первичный ключ), наименование должности, зарплата

Основной файл данных - список сотрудников: фамилия, код должности (внешний ключ)

Особенности предметной области:

а) могут быть сотрудники с одинаковой фамилией;

б) зарплата определяется должностью.

Алгоритм:

1) файлы типизированные

2) ввод данных в файлы

- открываем файл

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

так, чтобы коды должности совпадали (вообще-то нужен контроль)

3) вывод данных

- последовательно читаем запись из основного файла;

- поиск по коду должности соответствующую запись в файле справочнике;

- вывод информацию в нужном формате;

Процедуры

1) основная: - ввод имен основного файла и файла справочника

- вызов процедур ввода данных в файлы

- вызов процедуры вывода информации

2) процедура заполнения файла справочника

3) процедура заполнения основного файла данных

4) процедура вывода информации из файлов в нужном формате