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

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

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

 
 Ответить  Открыть новую тему 
> Операции над записями и типизированными файлами., Запутался...
сообщение
Сообщение #1


Новичок
*

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

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


Чуток запутался. И не получается правильно отладить прогу. Задание такое:
Описать структуру с именем Note, содержащую поля:
-фамилия, имя.
-номер телефона.
-дата рождения(массив из 3 чисел).
Написать программу выполняющую следующие действия с помощью процедур и функций:
-ввод с клавиатуры данных в файл, состоящий из элементов типа Note,
записи должны быть упорядочены по датам рождения.
-чтение данных из этого файла.
-вывод информации о человеке, номер телефона которого введен с клавы.
-Если такого нет, то вывести соотвествующее сообщение.

вот мои труды(компилируется, но все кроме создания и записи в файл криво работает):
uses crt;
type
Note=record
First_Last_name:string[20];
Phone_number:string[14];
B_date:record
year:string[4];
month:string[8];
day:string[2];
end;
end;
Var tab_file: file of Note;
f1,f2:Note;
Tab:array[1..50] of note;
i:integer;

Procedure create_file;
begin
seek(tab_file,FileSize(tab_file));
Writeln('vvedite svedenia');
writeln('esli hotite viyti napejatayte *');
while true do
begin
write ('vvedite familiu i Ima');
readln(f1.First_Last_name);
if f1.First_Last_name='*' then break;
write ('vvedite nomer telefona v mejdunarondom formate +38(cod)nomer');
readln(f1.Phone_number);
write('vvedite god rojdenia');
readln(f1.b_date.year);
writeln('vvedite mesiac rojdenia');
readln(f1.b_date.month);
writeln('vvedite den rojdenia');
readln(f1.b_date.day);
write(tab_file,f1);
end
end;

Procedure Sort_tab;
var i,j:integer;
begin
seek(tab_file,0);
for i:=filesize(tab_file)-1 downto 1 do
for j:=1 to i-1 do
begin
seek(tab_file,j);
read(tab_file,f1,f2);
if f1.b_date.year <> f2.b_date.year
Then
begin
if f1.b_date.year > f2.b_date.year
then
begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end

else
begin
if f1.B_date.month <> f2.B_date.month
then
begin
if f1.B_date.month > f2.B_date.month
Then
begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;

end
else

begin
if f1.B_date.day <> f2.B_date.day
then
begin
if f1.B_date.day > f2.B_date.day
Then
begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end;
end;
end;


end;
end;

Procedure print_file;
begin
seek(tab_file,0);
writeln('Familiya ima':20,'nomer telefona':14,'data rojdeniya':30);
while not eof (tab_file) do
begin
read(tab_file,f1);
writeln(f1.First_Last_name:20,f1.Phone_number:14,f1.b_date.year,f1.b_date.month,f1.b_date.day);
end;
readln;
end;

procedure Search;
var found:boolean;
S:string[15];
f_person:integer;

begin
f_person:=0;
while true do
begin
writeln('vvedite nomer ili *');
readln(s);
if s='*' then break;
found:=false;
seek(tab_file,0);

while not eof(tab_file) and not Found do
begin
read(tab_file,f1);
if pos(s,f1.phone_number)<>0 then
begin
writeln(f1.First_Last_name:20,f1.Phone_number:14,f1.b_date.year,f1.b_date.month,f1.b_date.day);
found:=true;
end;
readln;
end;
end;
if not Found then
Writeln('takix net');
readln;
end;

begin

Assign (tab_file,'d:\gogi.txt');
reset(tab_file);
{$|-}
reset(tab_file);
{$|+}
if IOResult=0 then
begin
writeln('dobavlenie v sushestv file');
end;
else
begin
rewrite(tab_file);
writeln('zapis v noviy file');
end;
readln;


while true do
begin
clrScr;
writeln('1 sozdanie file');
writeln('2 sortirovka file');
writeln('3 vyvod soderjimogo');
writeln('4 poisk po telefonu');
writeln('5 exit');
writeln('-------------------');
writeln('vvedyte nomer punkta menu');
readln(i);
case i of
1:create_file;
2:Sort_tab;
3:print_file;
4:Search;
5:exit;
end
end;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
вот мои труды(компилируется
Неправда, в приведенном тобой виде это даже не компилируется...
1) перед Else нельзя ставить точку с запятой, а у тебя она стоит;
2)
Цитата
   {$|-}
reset(tab_file);
{$|+}

- это просто комментарии, причем этот фрагмент кода не имеет смысла: если файла изначально нет, то вылет программы с ошибкой обеспечен. Надо делать вот так:

Assign (tab_file,'gogi.txt');
{$i-} reset(tab_file); {$i+}
if IOResult=0 then writeln('dobavlenie v sushestv file')
else begin
rewrite(tab_file);
writeln('zapis v noviy file');
end;
readln;
...

Ну и дальше: сортировка... Смотри, что ты делаешь:
                      if f1.B_date.month > f2.B_date.month
Then
а в каком виде ты вводишь месяц, можно уточнить? Если в виде номера, то непонятно зачем при определении типа Note у тебя month имеет тип String[8]? А если в виде строки (названия, в смысле), то почему ты сравниваешь таким вот образом? ведь 'январь' будет больше чем 'декабрь', а 'август' меньше чем 'май'... Уточни этот момент.

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


И правда...проспал насчет месяца. Ввожу число. Значит можно написать, integer...
на самом деле, я просто не знал в чем ошибка, и поэтому пробовал без проверки на ошибки, и запись-допись. ( я списал этот момент с учебника и думал, у меня просто компилятор туповатый).
А процедура поиска правильная?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
Значит можно написать, integer...
И не только в month, а и в year и в day тоже.

Цитата
А процедура поиска правильная?
Логически не совсем понятно. То есть, я ввел номер, которого в базе нет. Мне, естественно, ничего не напечатало, ни одной фамилии. Потом у меня процедура просит "введите номер или *", и только когда я ввожу звездочку, мне печатается "таких нет"? Не поздновато?

Еще один момент: я же могу (в смысле, твоя процедура позволяет это) сразу же ввести звездочку на запрос? И у тебя получается новый вариант "русской рулетки", потому что никогда не знаешь, чему будет равно Found в таком случае. И ни с того ни с сего можно получить "таких нет". Хотя это, как бы, и не ожидалось...

Кроме того, назначение f_person тоже не понятно. Объяснишь? smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

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

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


эээ, наверно, когда писал, забыл её где-то использовать)
и у меня кстати все равно с сортировкой проблемы. Почему-то он полностью игнорирует, год, а сортирует все по месяцу рождения....
В общей сложности получается, что когда мы сразу вводим * он должен оборвать цикл поиска, на сколько я понимаю, я где-то проспал написать, что в случае когда нету такого номера, Found принимает значение False.
Ток я не могу понять, где.
А в моем случае, Found принимает значение False, только тогда когда пользователь нажмет *, чтобы оборвать цикл. действительно поздновато...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Цитата
А в моем случае, Found принимает значение False, только тогда когда пользователь нажмет *, чтобы оборвать цикл. действительно поздновато...
Тебе достаточно просто if not found внести внутрь цикла while true do, если бы код был отформатирован правильно, ты бы сразу увидел, как это сделать:

вот твой же код, только записанный немного по-другому, "лесенкой":
 procedure Search;
var found:boolean;
S:string[15];
f_person:integer;

begin
f_person:=0;
while true do begin
writeln('vvedite nomer ili *'); readln(s);
if s='*' then break;

found:=false;
seek(tab_file,0);

while not eof(tab_file) and not Found do begin
read(tab_file,f1);
if pos(s,f1.phone_number)<>0 then begin
writeln(f1.First_Last_name:20,f1.Phone_number:14,f1.b_date.year,f1.b_date.month,f1.b_date.day);
found:=true;
end;
readln;
end;
end; { while true }

if not Found then
Writeln('takix net');
readln;
end; { procedure }



А вот так исправляется проблема:
 procedure Search;
var found:boolean;
S:string[15];
f_person:integer;

begin
f_person:=0;
while true do begin
writeln('vvedite nomer ili *'); readln(s);
if s='*' then break;

found:=false;
seek(tab_file,0);

while not eof(tab_file) and not Found do begin
read(tab_file,f1);
if pos(s,f1.phone_number)<>0 then begin
writeln(f1.First_Last_name:20,f1.Phone_number:14,f1.b_date.year,f1.b_date.month,f1.b_date.day);
found:=true;
end;
readln;
end;

if not Found then
Writeln('takix net');
readln;
end; { while true }

end; { procedure }



Цитата
и у меня кстати все равно с сортировкой проблемы. Почему-то он полностью игнорирует, год, а сортирует все по месяцу рождения....
Все нормально сортирует, если ты вспомнишь, что компоненты файлов нумеруются с 0, а не с 1:
 Procedure Sort_tab;
var i,j:integer;
begin
seek(tab_file,0);
for i:=filesize(tab_file)-1 downto 1 do
for j:=0 to i-1 do begin { <--- Вот тут у тебя была проблема }

seek(tab_file,j);
read(tab_file,f1,f2);

if f1.b_date.year <> f2.b_date.year Then begin
if f1.b_date.year > f2.b_date.year then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end
else begin
if f1.B_date.month <> f2.B_date.month then begin
if f1.B_date.month > f2.B_date.month Then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end
else begin
if f1.B_date.day <> f2.B_date.day then begin
if f1.B_date.day > f2.B_date.day Then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end;
end;
end;

end; { for j }
end;


Вот чего выдает (вводилось все вразнобой, естественно):

1 sozdanie file
2 sortirovka file
3 vyvod soderjimogo
4 poisk po telefonu
5 exit
-------------------
vvedyte nomer punkta menu
3
Familiya imanomer telefona data rojdeniya
trtr 9696196784
jgjg 6589197118
ppl 6565197947
plllol 6485198054
ii 5465198058
(кстати, поправь вывод данных - хотя бы раздели пробелами год, месяц и число рождения. Номера телефонов вводились четырехзначные)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

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

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


Огромное спасибо, Вы очень мне помогли. Обязательно учту ценное замечание, насчет записи программы в лесенку....
Выкладываю код, может кто-нибудь столкнется с подобными вопросами, как и у меня .
program Project1;
uses
crt;

type
Note=record
First_Last_name:string[20];
Phone_number:string[14];
B_date:record
year:integer;
month:integer;
day:integer;
end;
end;
Var tab_file: file of Note;
f1,f2:Note;

i:integer;

Procedure create_file;
begin
seek(tab_file,FileSize(tab_file));
Writeln('vvedite svedenia');
writeln('esli hotite viyti napejatayte *');
while true do
begin
write ('vvedite familiu i Ima');
readln(f1.First_Last_name);
if f1.First_Last_name='*' then break;
write ('vvedite nomer telefona v mejdunarondom formate +38(cod)nomer');
readln(f1.Phone_number);
write('vvedite god rojdenia__');
readln(f1.b_date.year);
write('vvedite mesiac rojdenia__');
readln(f1.b_date.month);
write('vvedite den rojdenia__');
readln(f1.b_date.day);
write(tab_file,f1);
end
end;

Procedure Sort_tab;
var i,j:integer;
begin
seek(tab_file,0);
for i:=filesize(tab_file)-1 downto 1 do
for j:=0 to i-1 do begin

seek(tab_file,j);
read(tab_file,f1,f2);

if f1.b_date.year <> f2.b_date.year Then begin
if f1.b_date.year > f2.b_date.year then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end
else begin
if f1.B_date.month <> f2.B_date.month then begin
if f1.B_date.month > f2.B_date.month Then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end
else begin
if f1.B_date.day <> f2.B_date.day then begin
if f1.B_date.day > f2.B_date.day Then begin
seek(tab_file,j);
write(tab_file,f2,f1);
end;
end;
end;
end;

end; { for j }
end;


Procedure print_file;
begin
seek(tab_file,0);
writeln('Familiya,ima':20,' nomer telefona':14,' data rojdeniya':15);
while not eof (tab_file) do
begin
read(tab_file,f1);
writeln(f1.First_Last_name:20, f1.Phone_number:14, f1.b_date.year:6, f1.b_date.month:3, f1.b_date.day:3);
end;
readln;
end;

procedure Search;
var found:boolean;
S:string[15];
f_person:integer;

begin
f_person:=0;
while true do begin
writeln('vvedite nomer ili *'); readln(s);
if s='*' then break;

found:=false;
seek(tab_file,0);

while not eof(tab_file) and not Found do begin
read(tab_file,f1);
if pos(s,f1.phone_number)<>0 then begin
writeln(f1.First_Last_name:20,f1.Phone_number:14,f1.b_date.year:5,f1.b_date.month:5,f1.b_date.day:3);
found:=true;
end;
readln;
end;

if not Found then
Writeln('takix net');
readln;
end; { while true }

end; { procedure }


begin

Assign (tab_file,'d:\gogi.txt');
{$i-} reset(tab_file); {$i+}
if IOResult=0 then writeln('dobavlenie v sushestv file')
else begin
rewrite(tab_file);
writeln('zapis v noviy file');
end;
readln;



while true do
begin
clrscr;
writeln('1 sozdanie file');
writeln('2 sortirovka file');
writeln('3 vyvod soderjimogo');
writeln('4 poisk po telefonu');
writeln('5 exit');
writeln('-------------------');
writeln('vvedyte nomer punkta menu');
readln(i);
case i of
1:create_file;
2:Sort_tab;
3:print_file;
4:Search;
5:exit;
end
end;
end.

Поправил вывод и ввод данных. Оставил, международный формат телефонов. Потому что у некоторых нет стационарного телефона.
Еще раз огромное спасибо за помощь!)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 24.10.2021 0:38
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name