Чуток запутался. И не получается правильно отладить прогу. Задание такое:
Описать структуру с именем 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.
{$|-}
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а в каком виде ты вводишь месяц, можно уточнить? Если в виде номера, то непонятно зачем при определении типа Note у тебя month имеет тип String[8]? А если в виде строки (названия, в смысле), то почему ты сравниваешь таким вот образом? ведь 'январь' будет больше чем 'декабрь', а 'август' меньше чем 'май'... Уточни этот момент.
Then
И правда...проспал насчет месяца. Ввожу число. Значит можно написать, integer...
на самом деле, я просто не знал в чем ошибка, и поэтому пробовал без проверки на ошибки, и запись-допись. ( я списал этот момент с учебника и думал, у меня просто компилятор туповатый).
А процедура поиска правильная?
эээ, наверно, когда писал, забыл её где-то использовать)
и у меня кстати все равно с сортировкой проблемы. Почему-то он полностью игнорирует, год, а сортирует все по месяцу рождения....
В общей сложности получается, что когда мы сразу вводим * он должен оборвать цикл поиска, на сколько я понимаю, я где-то проспал написать, что в случае когда нету такого номера, Found принимает значение False.
Ток я не могу понять, где.
А в моем случае, Found принимает значение False, только тогда когда пользователь нажмет *, чтобы оборвать цикл. действительно поздновато...
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 }
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
Огромное спасибо, Вы очень мне помогли. Обязательно учту ценное замечание, насчет записи программы в лесенку....
Выкладываю код, может кто-нибудь столкнется с подобными вопросами, как и у меня .
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.