IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> работа с базой записей, поиск удаление
and 1
сообщение 10.12.2010 22:16
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Посмотрите пожалуйста, что не так. (иногда может выбить ошибку 200, но это неважно). В меню записываются фамилии, успешно добавляется, но когда выбираешь показать все записи (не сортировать, по фамилии...) экран пуст. Может что-то неправильно в процедуре Writephone. Или они попросту не сохраняются?

program Phonebook;
uses Crt;
type Phone = record
SurnameS : string[15];
NameS : string[15];
PhoneS : string[15];
AddressS: string[50];
end;
var PhoneF : file of Phone;
PhoneR : Phone;
filename : string;
a : array[1..600] of Phone;
procedure WritePhone;
begin
Assign(PhoneF,filename);
Reset(PhoneF);
ClrScr;
writeln('Vse zapisi: ');
writeln;
while not Eof(PhoneF) do
begin
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
read(PhoneF,PhoneR);
writeln;
write(' ',PhoneR.SurnameS);
write(' ',PhoneR.NameS);
write(' ',PhoneR.PhoneS);
write(' ',PhoneR.AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure AddPhone;
begin
Assign(PhoneF,filename);
Reset(PhoneF);
while not Eof(PhoneF) do Read(PhoneF,PhoneR);
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
ClrScr;
writeln('Dobavlenie zapisi: ');
writeln;
Write('Vvedite familiy: ');
readln(PhoneR.SurnameS);
write('Vvedite imya: ');
readln(PhoneR.NameS);
write('Vvedite nomer telefona: ');
readln(PhoneR.PhoneS);
write('Vvedite adres: ');
readln(PhoneR.AddressS);
write(PhoneF,PhoneR);
Close(PhoneF);
writeln;
writeln('Zapis uspehno dobavlena v bazu !!!');
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure DeletePhone;
var temp : file of Phone;
Nazv : string[15];
begin
Assign(PhoneF,filename);
Reset(PhoneF);
Assign(temp,filename);
Rewrite(temp);
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
ClrScr;
writeln('Udalenie zapisi: ');
writeln;
Write('Vvedite familiy: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
Read(PhoneF,PhoneR);
if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR);
end;
Close(temp);
Close(PhoneF);
Erase(PhoneF);
Rename(temp,filename);
writeln;
writeln('Zapis uspehno udalena iz bazu !!!');
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure EditPhone;
var Nazv : string[15];
temp : file of Phone;
begin
Assign(PhoneF,filename);
Reset(PhoneF);
Assign(temp,filename);
Rewrite(temp);
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
ClrScr;
writeln('Redaktirovanie zapisi: ');
writeln;
Write('Vvedite familiy, kotoruy hotite izmenit: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
Read(PhoneF,PhoneR);
if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR);
end;
writeln;
write('Vvedite novuy familiy: ');
readln(PhoneR.SurnameS);
write('Vvedite novoe imya: ');
readln(PhoneR.NameS);
write('Vvedite novyi nomer telefona: ');
readln(PhoneR.PhoneS);
write('Vveddite novyi adres: ');
readln(PhoneR.AddressS);
write(temp,PhoneR);
Close(temp);
Close(PhoneF);
Erase(PhoneF);
Rename(temp,filename);
writeln;
writeln('Zapis uspehno izmenena !!!');
writeln;
write('Nagmite lybuy klavishy ...');
ReadKey;
end;
procedure FindSurname;
var Nazv : string[15];
k : integer;
begin
k:=0;
Assign(PhoneF,filename);
Reset(PhoneF);
ClrScr;
writeln('Poisk zapisi po familii: ');
writeln;
Write('Vvedite familiy: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
read(PhoneF,PhoneR);
if PhoneR.SurnameS=Nazv then
begin
writeln;
write(' ',PhoneR.SurnameS);
write(' ',PhoneR.NameS);
write(' ',PhoneR.PhoneS);
write(' ',PhoneR.AddressS);
k:=k+1;
end;
end;
Close(PhoneF);
writeln;
writeln;
writeln('Poisk zavershen, naideno zapisei: ',k);
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure FindPhone;
var Nazv : string[15];
k : integer;
begin
k:=0;
Assign(PhoneF,filename);
Reset(PhoneF);
ClrScr;
writeln('Poisk zapisi po nomeru telefona: ');
writeln;
Write('Vvedite nomer telefona: ');
readln(Nazv);
while not Eof(PhoneF) do
begin
PhoneR.SurnameS:=' ';
PhoneR.NameS:=' ';
PhoneR.PhoneS:=' ';
PhoneR.AddressS:=' ';
read(PhoneF,PhoneR);
if PhoneR.PhoneS=Nazv then
begin
writeln;
write(' ',PhoneR.SurnameS);
write(' ',PhoneR.NameS);
write(' ',PhoneR.PhoneS);
write(' ',PhoneR.AddressS);
k:=k+1;
end;
end;
Close(PhoneF);
writeln;
writeln;
writeln('Poisk zavershen, naideno zapisei: ',k);
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortSurname;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po familii: ');
writeln;
while not Eof(PhoneF) do begin
inc(c,1);
read(PhoneF,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].SurnameS>a[j+1].SurnameS then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurnameS);
write(' ',a[i].NameS);
write(' ',a[i].PhoneS);
write(' ',a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortAddress;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po adresu: ');
writeln;
while not Eof(PhoneF) do begin
inc(c,1);
read(PhoneF,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].AddressS>a[j+1].AddressS then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurnameS);
write(' ',a[i].NameS);
write(' ',a[i].PhoneS);
write(' ',a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;
procedure SortPhone;
var i,j,c: integer;
tr: Phone;
begin
c:=0;
Assign(PhoneF, filename);
Reset(PhoneF);
ClrScr;
writeln('Sortirovka po nomeru telefona: ');
writeln;
while not Eof(PhoneF) do begin
inc(c,1);
read(PhoneF,a[c]);
end;
for i:=1 to c do
for j:=1 to c-1 do begin
if a[j].PhoneS>a[j+1].PhoneS then begin
tr:=a[j+1];
a[j+1]:=a[j];
a[j]:=tr;
end;
end;
for i:=1 to c do begin
writeln;
write(a[i].SurnameS);
write(' ',a[i].NameS);
write(' ',a[i].PhoneS);
write(' ',a[i].AddressS);
end;
Close(PhoneF);
writeln;
writeln;
write('Nagmite lybuy klavishu ...');
ReadKey;
end;

procedure SortType;
var b: integer;
begin
repeat
begin
ClrScr;
writeln('"Telefonnyi spravochnik" - meny sortirovki');
writeln;
writeln('1. Ne sortirovat');
writeln('2. Sortirovat po familii');
writeln('3. Sortirovat po adresu');
writeln('4. Sortirovat po nomeru telefona');
writeln('----------------------------');
writeln('5. Vozvrat v glavnoe meny');
writeln;
write('Vyberite punkt meny: ');
readln(b);
case b of
1 : WritePhone;
2 : SortSurname;
3 : SortAddress;
4 : SortPhone;
end;
end;
until b=5;
end;
procedure PhoneMenu;
var b: integer;
begin
repeat
begin
ClrScr;
writeln('"Telefonnyi spravochnik" - glavnoe meny');
writeln;
writeln('1. Pokazat vse zapisi');
writeln('2. Dobavit zapis');
writeln('3. Udalit zapis');
writeln('4. Redaktirovat zapis');
writeln('5. Poisk po familii');
writeln('6. Poisk po nomeru telefona');
writeln('----------------------------');
writeln('7. Vyhod');
writeln;
write('Vyberite punkt meny: ');
readln(b);
case b of
1 : SortType;
2 : AddPhone;
3 : DeletePhone;
4 : EditPhone;
5 : FindSurname;
6 : FindPhone;
end;
end;
until b=7;
end;
begin
ClrScr;
PhoneMenu;
end.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
and 1
сообщение 10.12.2010 23:11
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


убрал файлнэйм, теперь спрашивает о неизвестном идентификаторе
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
and 1   работа с базой записей, поиск удаление   10.12.2010 22:16
Freedom   Посмотрите пожалуйста, что не так. (иногда может ...   10.12.2010 22:43
and 1   у меня с расширением .pas от Паскаль ABC, а при ис...   10.12.2010 23:06
volvo   Можно показать, ГДЕ?   10.12.2010 23:07
and 1   убрал файлнэйм, теперь спрашивает о неизвестном ид...   10.12.2010 23:11
volvo   Я не просил убирать, я просто намекнул, что если е...   10.12.2010 23:13
and 1   покажи как хоть в одной процедуре её указать   10.12.2010 23:29
volvo   А ее не надо в процедуре указывать. Нужно либо жес...   11.12.2010 2:05
and 1   никак не получается, PhoneMenu пишется как неизвес...   11.12.2010 13:27
volvo   Так... Давай-ка присоединяй свою программу файлом,...   11.12.2010 13:41
and 1   вот сам файл. Первый пост компилировался, но ВСЕ З...   11.12.2010 18:45
Freedom   вот сам файл. Первый пост компилировался, но ВСЕ ...   11.12.2010 19:44
volvo   Это неизмененный файл. Я сказал, что надо с ним де...   11.12.2010 21:40
and 1   вот исправлено по 12 посту, но выбивает опять ошиб...   11.12.2010 22:11
Freedom   вот исправлено по 12 посту, но выбивает опять оши...   11.12.2010 22:34
and 1   писецццццццццц вроде все работает, благодарен тебе...   11.12.2010 22:44


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.06.2025 23:52
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"