Операции над записями и типизированными файлами., Запутался... Опции

[TheKnyazz]

Чуток запутался. И не получается правильно отладить прогу. Задание такое:
Описать структуру с именем 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.

[volvo]

вот мои труды(компилируется

Неправда, в приведенном тобой виде это даже не компилируется...
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 - 29.11.2008 20:23

[TheKnyazz]

И правда...проспал насчет месяца. Ввожу число. Значит можно написать, integer...
на самом деле, я просто не знал в чем ошибка, и поэтому пробовал без проверки на ошибки, и запись-допись. ( я списал этот момент с учебника и думал, у меня просто компилятор туповатый).
А процедура поиска правильная?

[volvo]

Значит можно написать, integer...

И не только в month, а и в year и в day тоже.

А процедура поиска правильная?

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

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

Кроме того, назначение f_person тоже не понятно. Объяснишь?

[TheKnyazz]

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

[volvo]

А в моем случае, 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

(кстати, поправь вывод данных - хотя бы раздели пробелами год, месяц и число рождения. Номера телефонов вводились четырехзначные)

[TheKnyazz]

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

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.

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