Помогите отладить программу
Помогите плиз народ срочно нужно.
проверьте прогу. понять не могу по поводу ошибок
{****************************************************************************}
{ Курсовая работа по дисциплине: }
{ }
{ . Версия под DOS.}
{****************************************************************************}
program adres_kn;
uses crt;
type baz=record
fam:string[50]; {фамилия}
nam:string[50]; {имя}
fath:string[50]; {категория}
adr:string[50]; {адрес}
tel:longint; {телефон}
end;
file_baz=file of baz;
var
F:file_baz;
namebd:string; { название и путь к базе данных}
{***********************************************************************}
procedure menu(var z:integer);
label 2;
var c:integer;
isok:boolean;
begin
textbackground(blue);
clrscr;
textcolor(yellow);
gotoxy(21,6);
write(chr(201));
for c:= 1 to 36 do write(chr(205));
writeln(chr(187));
for c:=7 to 18 do
begin
gotoxy(21,c);
writeln(chr(186));
gotoxy(58,c);
writeln(chr(186));
end;
gotoxy(21,19);
write(chr(200));
for c:=1 to 37 do write(chr(205));
gotoxy(58,19);write(chr(188));
writeln;
gotoxy(24,7);textcolor(lightred);
writeln('*****ТЕЛЕФОННЫЙ СПРАВОЧНИК*****');
gotoxy(24,8); textcolor(yellow);
writeln('=================================');
gotoxy(24,9); writeln('ПРОСМОТР БАЗЫ ДАННЫХ -1');
gotoxy(24,10);writeln('ДОБАВИТЬ ЗАПИСЬ В БАЗУ ДАННЫХ -2');
gotoxy(24,11);writeln('РЕДАКТИРОВАНИЕ БАЗЫ ДАННЫХ -3');
gotoxy(24,12);writeln('ПОИСК В БАЗЕ ДАННЫХ -4');
gotoxy(24,13);writeln('УДАЛЕНИЕ ДАННЫХ -5');
gotoxy(24,14);writeln('СОРТИРОВКА -6');
gotoxy(24,15);writeln('ВЫХОД -7');
gotoxy(24,16);writeln('=================================');
writeln;
2: gotoxy(24,17);textcolor(white);
write('ВЫБИРИТЕ РЕЖИМ РАБОТЫ -');
{$I-}
repeat
readln(z);
isok:=IoResult=0;
if not isok then
begin
gotoxy(24,18); textcolor(lightred);
writeln('ОШИБКА ВВОДА!!!');goto 2;
end;
until isok;
{$I+}
if z>7 then
begin
gotoxy(24,18);textcolor(lightred);
writeln('Такого режима нет!'); goto 2;
end;
end; {menu}
procedure menu2(var n:integer);
var
isok:boolean;
begin
writeln('По фамилии -1');
writeln('По имени -2');
writeln('По адресу -3');
writeln('По примечание -4');
writeln('По телефону -5');
writeln('Вернуться в меню -6');
writeln;
{$I-}
repeat
write('Выбирите режим работы: -');readln
;
isok:=IoResult=0;
if not isok then writeln('ошибка ввода!!!');
until isok;
{$I+}
end;
procedure poisk(var n:integer;var F:file_baz;s:string); {Поиск в базе данных}
var
o:char;
sc:string;
m:integer;
n1:longint;
x:baz;
isok:boolean;
begin
case n of
1: begin
clrscr; m:=0;
write('Введите фамилию - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.fam) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такой фамилии в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
2: begin
clrscr; m:=0;
write('Введите имя - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.nam) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такго имени в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
3: begin
clrscr; m:=0;
write('Введите адрес - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.adr) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого адреса в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
4: begin
clrscr; m:=0;
write('Введите примечание - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.fath) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого примечания в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
5: begin
clrscr; m:=0;
{$I-}
repeat
write('Введите номер телефона - ');readln(n1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода!!!');
until isok;
{$I+}
while not eof(f) do
begin {while}
read(f,x);
with x do
if n1=(x.tel) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,' ');
write(x.adr,' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого номера в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
end;{case}
end;
{************************************************************************}
procedure prosm_bd(var F:file_baz;s:string); {Просмотр базы данных}
var
c:integer;
x:baz;
begin
textbackground(blue);
c:=0;
clrscr;
assign(f,s);
reset(f);
textcolor(lightgreen);
writeln('ФАМИЛИЯ':12,'ИМЯ':10,
'АДРЕС':27,'ПРИМЕЧАНИЕ':12,' ТЕЛЕФОН':12);
while not eof(f) do
begin
read(f,x);
with x do
textcolor(white);
write(x.fam:12,' ');
write(x.nam:10,' ');
write(x.adr:25,' ');
write(x.fath:10,' ');textcolor(yellow);
write(x.tel:12);textcolor(white);
c:=c+1;
writeln;
if c>20 then
begin
write('Для продолжения вывода информации нажмите любую клавишу...');
readkey;
clrscr;c:=0;textcolor(lightgreen);
writeln('ФАМИЛИЯ':12,'ИМЯ':10,
'АДРЕС':27,'ПРИМЕЧАНИЕ':12,' ТЕЛЕФОН':12);
end;{if}
end; {while}
writeln;
writeln('Всего записей в базе-',filesize(f));
writeln;
close(f);
end;
procedure append_bd(var F:file_baz;s:string);{Добавление записи в базу}
var
c:char;
x:baz;
isok:boolean;
begin
textbackground(black);
clrscr;
assign(f,s);
reset(f);
seek(f,filesize(f)); {перемещает указатель в конец файла}
repeat
with x do
begin
write('Фамилия :'); readln(fam);
write('Имя :'); readln(nam);
write('Адрес :'); readln(adr);
write('Примечание :'); readln(fath);
{$I-}
repeat
write('Телефон :'); readln(tel);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
end;
{$I+}
write(F,x);
clrscr;
writeln('Будите еще вводить данные?: да- ENTER, нет-ESC+ENTER ');
c:=readkey;
until(c=#27);
close(F);
end;
{***************************************************************************}
{ удаление записи из базы по заданному критерию}
procedure del_bd(var n:integer;var F:file_baz;s:string);
var
d:char;
n1:longint;
c,m:integer;
f1:file_baz;
x:baz;
cs,s1:string;
isok:boolean;
begin
assign(f,s);assign(f1,'copy_del');{открываем новы файл для записи и }
reset(f); rewrite(f1); {и преносим туда строки которые }
{не надо удалять}
case n of
1: begin
clrscr;
writeln('Введите фамилию...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.fam then write(f1,x);
if cs=x.fam then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end; {закрываем оба файла}
close(f);close(f1);erase(f); {удаляем исходный файл}
rename(f1,s); {копию переименовываем в начальный ф}
end;{1}
2: begin
writeln('Введите имя...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.nam then write(f1,x);
if cs=x.nam then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{2}
3: begin
writeln('Введите адрес...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.adr then write(f1,x);
if cs=x.adr then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{3}
4: begin
writeln('Введите примечание...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.fath then write(f1,x);
if cs=x.fath then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{4}
5: begin
{$I-}
repeat
writeln('Введите номер телефона...');read(n1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
{$I+}
while not(eof(f)) do
begin
with x do
read(f,x);
if n1<>x.tel then write(f1,x);
if n1=x.tel then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{3}
end;{case}
end;
{**************************************************************************}
procedure red_baz(var n:integer;var F:file_baz;s:string);
var
c:char;
cs,cs1:string;
x:baz;
t,t1:longint;
isok:boolean;
begin
case n of
1:begin
write('Какую Фамилию вы хотите изменить? -');readln(cs);
write('Новая Фамилия: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{while}
with x do
read(f,x);
if cs=x.fam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.fam:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{1}
2: begin
write('Какое имя вы хотите изменить? -');readln(cs);
write('Новое имя: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin
with x do
read(f,x);
if cs=x.nam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.nam:=cs1;
write(f,x);
break;
end;
end;{while}
close(f);
end;{2}
3: begin
write('Какой адрес вы хотите изменить? -');readln(cs);
write('Новый адрес: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.adr then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.adr:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{3}
4: begin
write('Укажите примечание которое вы хотите изменить? -');readln(cs);
write('Новое примечание: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.fath then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.fath:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{4}
5: begin
{$I-}
repeat
writeln('Какой телефон вы хотите изменить?');read(t);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
repeat
writeln('Новый телефон: -');read(t1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
{$I+}
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if t=x.tel then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.tel:=t1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{5}
7: begin {редактирование всей строки}
write('Укажите Фамилию,для редактирования всей строки -');readln(cs);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.fam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
writeln('Заполните...');
write('Фамилия :');readln(x.fam);
write('Имя :');readln(x.nam);
write('Адрес :');readln(x.adr);
write('Примечание :');readln(x.fath);
write('Телефон :');readln(x.tel);
seek(f,FilePos(f)-1);
write(f,x);
break;
end;
end;{with}
close(f);
end;{6}
end;{case}
end;{red_baz}
{*****************************************************************************}
Помогите плиз народ срочно нужно.
проверьте прогу. понять не могу по поводу ошибок
{****************************************************************************}
{ Курсовая работа по дисциплине: }
{ }
{ . Версия под DOS.}
{****************************************************************************}
program adres_kn;
uses crt;
type baz=record
fam:string[50]; {фамилия}
nam:string[50]; {имя}
fath:string[50]; {категория}
adr:string[50]; {адрес}
tel:longint; {телефон}
end;
file_baz=file of baz;
var
F:file_baz;
namebd:string; { название и путь к базе данных}
{***********************************************************************}
procedure menu(var z:integer);
label 2;
var c:integer;
isok:boolean;
begin
textbackground(blue);
clrscr;
textcolor(yellow);
gotoxy(21,6);
write(chr(201));
for c:= 1 to 36 do write(chr(205));
writeln(chr(187));
for c:=7 to 18 do
begin
gotoxy(21,c);
writeln(chr(186));
gotoxy(58,c);
writeln(chr(186));
end;
gotoxy(21,19);
write(chr(200));
for c:=1 to 37 do write(chr(205));
gotoxy(58,19);write(chr(188));
writeln;
gotoxy(24,7);textcolor(lightred);
writeln('*****ТЕЛЕФОННЫЙ СПРАВОЧНИК*****');
gotoxy(24,8); textcolor(yellow);
writeln('=================================');
gotoxy(24,9); writeln('ПРОСМОТР БАЗЫ ДАННЫХ -1');
gotoxy(24,10);writeln('ДОБАВИТЬ ЗАПИСЬ В БАЗУ ДАННЫХ -2');
gotoxy(24,11);writeln('РЕДАКТИРОВАНИЕ БАЗЫ ДАННЫХ -3');
gotoxy(24,12);writeln('ПОИСК В БАЗЕ ДАННЫХ -4');
gotoxy(24,13);writeln('УДАЛЕНИЕ ДАННЫХ -5');
gotoxy(24,14);writeln('СОРТИРОВКА -6');
gotoxy(24,15);writeln('ВЫХОД -7');
gotoxy(24,16);writeln('=================================');
writeln;
2: gotoxy(24,17);textcolor(white);
write('ВЫБИРИТЕ РЕЖИМ РАБОТЫ -');
{$I-}
repeat
readln(z);
isok:=IoResult=0;
if not isok then
begin
gotoxy(24,18); textcolor(lightred);
writeln('ОШИБКА ВВОДА!!!');goto 2;
end;
until isok;
{$I+}
if z>7 then
begin
gotoxy(24,18);textcolor(lightred);
writeln('Такого режима нет!'); goto 2;
end;
end; {menu}
procedure menu2(var n:integer);
var
isok:boolean;
begin
writeln('По фамилии -1');
writeln('По имени -2');
writeln('По адресу -3');
writeln('По примечание -4');
writeln('По телефону -5');
writeln('Вернуться в меню -6');
writeln;
{$I-}
repeat
write('Выбирите режим работы: -');readln
;isok:=IoResult=0;
if not isok then writeln('ошибка ввода!!!');
until isok;
{$I+}
end;
procedure poisk(var n:integer;var F:file_baz;s:string); {Поиск в базе данных}
var
o:char;
sc:string;
m:integer;
n1:longint;
x:baz;
isok:boolean;
begin
case n of
1: begin
clrscr; m:=0;
write('Введите фамилию - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.fam) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такой фамилии в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
2: begin
clrscr; m:=0;
write('Введите имя - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.nam) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такго имени в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
3: begin
clrscr; m:=0;
write('Введите адрес - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.adr) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого адреса в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
4: begin
clrscr; m:=0;
write('Введите примечание - ');readln(sc);
while not eof(f) do
begin {while}
read(f,x);
with x do
if sc=(x.fath) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,',',' ');
write(x.adr,',',' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого примечания в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
5: begin
clrscr; m:=0;
{$I-}
repeat
write('Введите номер телефона - ');readln(n1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода!!!');
until isok;
{$I+}
while not eof(f) do
begin {while}
read(f,x);
with x do
if n1=(x.tel) then
begin
m:=m+1;
write(x.fam,' ');
write(x.nam,' ');
write(x.fath,' ');
write(x.adr,' ');
writeln(x.tel);
end; {if}{with}
end; {while}
if m=0 then
writeln('Такого номера в базе данных нет!');
writeln('....нажмите любую клавишу');
end;
end;{case}
end;
{************************************************************************}
procedure prosm_bd(var F:file_baz;s:string); {Просмотр базы данных}
var
c:integer;
x:baz;
begin
textbackground(blue);
c:=0;
clrscr;
assign(f,s);
reset(f);
textcolor(lightgreen);
writeln('ФАМИЛИЯ':12,'ИМЯ':10,
'АДРЕС':27,'ПРИМЕЧАНИЕ':12,' ТЕЛЕФОН':12);
while not eof(f) do
begin
read(f,x);
with x do
textcolor(white);
write(x.fam:12,' ');
write(x.nam:10,' ');
write(x.adr:25,' ');
write(x.fath:10,' ');textcolor(yellow);
write(x.tel:12);textcolor(white);
c:=c+1;
writeln;
if c>20 then
begin
write('Для продолжения вывода информации нажмите любую клавишу...');
readkey;
clrscr;c:=0;textcolor(lightgreen);
writeln('ФАМИЛИЯ':12,'ИМЯ':10,
'АДРЕС':27,'ПРИМЕЧАНИЕ':12,' ТЕЛЕФОН':12);
end;{if}
end; {while}
writeln;
writeln('Всего записей в базе-',filesize(f));
writeln;
close(f);
end;
procedure append_bd(var F:file_baz;s:string);{Добавление записи в базу}
var
c:char;
x:baz;
isok:boolean;
begin
textbackground(black);
clrscr;
assign(f,s);
reset(f);
seek(f,filesize(f)); {перемещает указатель в конец файла}
repeat
with x do
begin
write('Фамилия :'); readln(fam);
write('Имя :'); readln(nam);
write('Адрес :'); readln(adr);
write('Примечание :'); readln(fath);
{$I-}
repeat
write('Телефон :'); readln(tel);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
end;
{$I+}
write(F,x);
clrscr;
writeln('Будите еще вводить данные?: да- ENTER, нет-ESC+ENTER ');
c:=readkey;
until(c=#27);
close(F);
end;
{***************************************************************************}
{ удаление записи из базы по заданному критерию}
procedure del_bd(var n:integer;var F:file_baz;s:string);
var
d:char;
n1:longint;
c,m:integer;
f1:file_baz;
x:baz;
cs,s1:string;
isok:boolean;
begin
assign(f,s);assign(f1,'copy_del');{открываем новы файл для записи и }
reset(f); rewrite(f1); {и преносим туда строки которые }
{не надо удалять}
case n of
1: begin
clrscr;
writeln('Введите фамилию...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.fam then write(f1,x);
if cs=x.fam then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end; {закрываем оба файла}
close(f);close(f1);erase(f); {удаляем исходный файл}
rename(f1,s); {копию переименовываем в начальный ф}
end;{1}
2: begin
writeln('Введите имя...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.nam then write(f1,x);
if cs=x.nam then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{2}
3: begin
writeln('Введите адрес...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.adr then write(f1,x);
if cs=x.adr then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{3}
4: begin
writeln('Введите примечание...');read(cs);
while not(eof(f)) do
begin
with x do
read(f,x);
if cs<>x.fath then write(f1,x);
if cs=x.fath then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{4}
5: begin
{$I-}
repeat
writeln('Введите номер телефона...');read(n1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
{$I+}
while not(eof(f)) do
begin
with x do
read(f,x);
if n1<>x.tel then write(f1,x);
if n1=x.tel then
begin
writeln('эту запись надо удалить? да- ESC+ENTER, нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.adr,' ',x.fath,' ',x.tel);
write(d);d:=readkey;
end;
if d=#13 then write(f1,x);
end;
close(f);close(f1);erase(f);
rename(f1,s);
end;{3}
end;{case}
end;
{**************************************************************************}
procedure red_baz(var n:integer;var F:file_baz;s:string);
var
c:char;
cs,cs1:string;
x:baz;
t,t1:longint;
isok:boolean;
begin
case n of
1:begin
write('Какую Фамилию вы хотите изменить? -');readln(cs);
write('Новая Фамилия: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{while}
with x do
read(f,x);
if cs=x.fam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.fam:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{1}
2: begin
write('Какое имя вы хотите изменить? -');readln(cs);
write('Новое имя: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin
with x do
read(f,x);
if cs=x.nam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.nam:=cs1;
write(f,x);
break;
end;
end;{while}
close(f);
end;{2}
3: begin
write('Какой адрес вы хотите изменить? -');readln(cs);
write('Новый адрес: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.adr then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.adr:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{3}
4: begin
write('Укажите примечание которое вы хотите изменить? -');readln(cs);
write('Новое примечание: -');read(cs1);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.fath then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.fath:=cs1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{4}
5: begin
{$I-}
repeat
writeln('Какой телефон вы хотите изменить?');read(t);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
repeat
writeln('Новый телефон: -');read(t1);
isok:=IoResult=0;
if not isok then writeln('ошибка ввода');
until isok;
{$I+}
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if t=x.tel then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
seek(f,FilePos(f)-1);
x.tel:=t1;
write(f,x);
break;
end;
end;{with}
close(f);
end;{5}
7: begin {редактирование всей строки}
write('Укажите Фамилию,для редактирования всей строки -');readln(cs);
assign(f,s);
reset(f);
while not eof(f) do
begin{with}
with x do
read(f,x);
if cs=x.fam then
begin
writeln('Вы хотите изменить эту запись? да-ESC,нет-ENTER');
writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
c:=readkey;
end;
if c=#27 then
begin
writeln('Заполните...');
write('Фамилия :');readln(x.fam);
write('Имя :');readln(x.nam);
write('Адрес :');readln(x.adr);
write('Примечание :');readln(x.fath);
write('Телефон :');readln(x.tel);
seek(f,FilePos(f)-1);
write(f,x);
break;
end;
end;{with}
close(f);
end;{6}
end;{case}
end;{red_baz}
{*****************************************************************************}
