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

[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]

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

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