Простенькая база данных

Сначала создаётся файл БД, признаком окончания ввода является пустая строка. Затем ищется некто who по полю name и выводятся его данные.
Вводим данные, а потом ищем по имени и выводим поиска на экран.

const bookname='phonbook.dat';
 
type
  TPhoneBook=record
    name, { Имя }
    surname: string[30]; { Фамилия }
    phone: string[10]; { Телефон }
  end;
 
var
  F: file of TPhoneBook; { Файл из записей }
  PhoneBook: TPhoneBook; { Текущая запись }
 
function Correct: boolean; { Функция прооверки корректности вводимых данных }
begin
     writeln;
     with PhoneBook do
     begin
          write('Enter name: '); readln(Name);
          write('Enter surname: '); readln(SurName);
          write('Enter phone: '); readln(Phone);
 
          Correct := (Name<>'') and (SurName<>'') and (Phone<>'');
     end;
end;
 
procedure CreateBook; { Создание файла с записями }
begin
     assign(f,bookname);
     {$I-}
     rewrite(F); { создаём файл }
     {$I+}
     if IOresult=0 then { Если не было ошибок, то }
        { добавлять записи в файл, пока корректно вводим данные }
        while Correct do write(F, PhoneBook);
 
     Close(F); { Закрываем файл }
end;
 
procedure Find; { Поиск по имени и вывод данных на экран }
var
  who: string[30];
  found: boolean;
begin
     write('Кого ищем? '); readln(who);
     if who='' then exit;
     found:=false;
 
     assign(f,bookname);
     {$I-}
     reset(F); { Открываем наш файл }
     {$I+}
     if IOresult=0 then
     with PhoneBook do
     while Not EOF(F) do { Ищем, пока не конец файла }
     begin
          read(F,PhoneBook);
          if name=who then  { Нашли такого/ую. Выводим данные на экран }
          begin
               writeln(Name:30,SurName:30,Phone:10);
               found:=true;
          end;
     end;
 
     Close(f); { Закрываем файл }
     if Not Found then writeln(Who,' не найден.');
end;
 
begin
     CreateBook;
     Find;
     writeln(#13#10'Жми Enter');
     readln;
end.
 
pascal/files/db.txt · Последние изменения: 2010/05/25 17:20 От romtek
 
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki