1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Посмотрите пожалуйста, что не так. (иногда может выбить ошибку 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.
Посмотрите пожалуйста, что не так. (иногда может выбить ошибку 200, но это неважно). В меню записываются фамилии, успешно добавляется, но когда выбираешь показать все записи (не сортировать, по фамилии...) экран пуст. Может что-то неправильно в процедуре Writephone. Или они попросту не сохраняются?
У меня всё нормально работает. И у меня вопрос к вам, входной файл, он сам создаётся? и как он называется?
Я не просил убирать, я просто намекнул, что если есть переменная, то надо в нее занести название файла, с которым программа работает. Ты этого в программе не сделал. Так каким образом оно вообще должно работать? Присвой переменной FileName значение: имя твоего файла данных...
А ее не надо в процедуре указывать. Нужно либо жестко "зашить" имя файла в программу, либо запросить его у пользователя в самом начале выполнения программы:
{ ... } begin ClrScr; FileName := 'MYFILE.DAT'; { <--- Путь не задается - файл будет в текущей директории } { или } { Write('Введите имя файла: '); ReadLn(FileName); } PhoneMenu; end.
Так... Давай-ка присоединяй свою программу файлом, а? Чтоб можно было НЕ КОПИРУЯ (исключим возможность ошибки при копировании полностью) взять и откомпилировать. И посмотреть, что именно не так. А то изменяешь, изменяешь, а что ты там изменяешь - непонятно.
Ты ж говоришь, что программа из первого поста работала у тебя? Что, добавил после ClrScr инициализацию переменной - теперь неизвестный идентификатор? Возникает вопрос а как оно до этого работало? Почему там не было неизвестного идентификатора???
вот сам файл. Первый пост компилировался, но ВСЕ ЗАПИСИ не просматриваются как у Freedom (второй ответ)
Поэтому я и спрашивал про входной файл. У меня заработало потому что я чуть чуть переделал
program Phonebook; uses Crt; type Phone = record SurnameS : string[15]; NameS : string[15]; PhoneS : string[15]; AddressS: string[50]; end; const filename='phone.txt'; // добавил это, и из переменных убрал filename var PhoneF : file of Phone; PhoneR : Phone; a : array[1..600] of Phone; ......
Правила форума
работа с базой записей, поиск удаление
