--- //[[romeeras@gmail.com|Romtek]] 2009/10/30 21:38//

====== Построение базы данных с применением коллекций ======

===== Введение =====

Коллекции - это одно из многочисленных применений ООП в программах.
Предлагаю вашему вниманию базу данных на основе коллекций. В ней мы рассмотрим такие операции
над коллекцией, как //добавление, редактирование, просмотр, поиск в коллекции, сохранения
и загрузки коллекции//.

Почему я решил показать именно на примере коллекций? Да потому, что я вижу их как очень удобную
структуру для хранения самой разной информации.

===== Использование коллекций =====

Что можно сделать с коллекциями:
  * Добавлять объекты в коллекцию
  * Изменять объекты в коллекции
  * Удалять объекты из коллекции
  * Искать объекты в коллекции по заданному критерию
  * Сохранять коллекции в файл
  * Читать коллекции с файла

Всё это позволяет механизм наследования. Таким образом, наследовав потомка с новыми характеристиками (допустим, имеющий собственный способ упорядочивания объектов в коллекции), можно добиться новой функциональности программы.

==== Объект ====

Возьмём для примера такую структуру:
<code pascal>type
     PRecord = ^TRecord;
     TRecord = record
       Name: String[12];
       Mark: Integer;
     end;</code>
Для того, чтобы работать с базой данных все знают, что нам нужен массив, хранящий эти записи:
<code pascal>type
     TDataArr = array [1..N] of TRecord;
     DB: file of TDataArr; { описание файловой переменной для работы с файлом }</code>
Для коллекции же необходимо создать объект, в котором будет находиться переменная (в данном случае //TransferRecord//)
типа //TRecord //(запись):
<code pascal>     PStudentInfo=^TStudentInfo;
     TStudentInfo=object(TObject)
       TransferRecord: TRecord;
       constructor Load(var S: TStream); { необходимо перекрывать для операции сохранения в поток (см. ниже) }
       procedure   Store(var S: TStream); { необходимо перекрывать для операции чтения с потока (см. ниже) }
       Procedure   Print;
     end;</code>

==== Сохранение объекта в поток и чтение с него (I/O) ====

Метод //Store// нужен для сохранения объекта в поток, а конструктор //Load// - для его загрузки из потока.
Метод //Print// выводит на экран данные о студенте из //TransferRecord//. Это, собственно, всё, что нам
требуется от объекта //TStudentInfo//.\\
Остальные операции будут проводиться с коллекцией.

==== Сортировка ====

<code pascal>     PStudentsColl=^TStudentsColl;
     TStudentsColl=object(TSortedCollection)
       function Compare(Key1, Key2: Pointer): Integer; virtual; { перекрываем метод сравнения }
     end;</code>

//TSortedCollection// является потомком обычной коллекции //TCollection//, только у неё имеется возможность
сортировки объектов. Т.к. функция сравнения //Compare// (с её помощью сортируется коллекция) является
абстрактной, её надо перекрывать, что мы и сделали:
<code pascal>
function TStudentsColl.Compare(Key1, Key2: Pointer): Integer;
begin
     Compare := StrICmp (
                  PStudentInfo(Key1)^.TransferRecord.Name,
                  PStudentInfo(Key2)^.TransferRecord.Name
                );
end;</code>
Здесь сравнение ведётся по имени студентов с помощью функции сравнения строк //StrICmp //(файл sortfunc.inc),
без учёта регистра букв. Можно сортировать по любому типу поля любыми видами сравнений.

==== Регистрация ====

В разделе инициализации модуля следует зарегистрировать типы //RStudentsColl// и //RStudentInfo//, чтобы не
возникало ошибок при работе с потоками:
<code pascal>  RegisterType (RStudentsColl);
  RegisterType (RStudentInfo);</code>
== Используемые в коллекции функции и процедуры ==
//At// - указатель на объект в коллекции\\ //Insert// - добавление в коллекцию\\ //AtDelete// - удаление объекта из коллекции\\ //FirstThat //- итератор для поиска по заданному условию.

===== Исходный код =====

Сам код программы я старался прокоментировать как можно более подробно:
<code pascal>
Unit StudObj;

Interface
Uses Objects;

type
     PRecord = ^TRecord;
     TRecord = record
       Name: String[12];
       Mark: Integer;
     end;

     PStudentInfo=^TStudentInfo;
     TStudentInfo=object(TObject)
       TransferRecord: TRecord;
       constructor Load(var S: TStream);
       procedure   Store(var S: TStream);
       Procedure   Print; Virtual;
     end;

     PStudentsColl=^TStudentsColl;
     TStudentsColl=object(TSortedCollection)
       function Compare(Key1, Key2: Pointer): Integer; virtual;
       procedure Error(Code, Info: Integer); virtual;
     end;


const
  RStudentInfo: TStreamRec = (
    ObjType: 55001;
    VmtLink: Ofs(TypeOf(TStudentInfo)^);
    Load:    @TStudentInfo.Load;
    Store:   @TStudentInfo.Store
  );

  RStudentsColl: TStreamRec = (
    ObjType: 55002;
    VmtLink: Ofs(TypeOf(TStudentsColl)^);
    Load: @TStudentsColl.Load;
    Store: @TStudentsColl.Store);


var
  PC: PStudentsColl;


Implementation
Uses Drivers;

type
     TLinkRecord = record
       PName: PString;
       PMark: longint;
     end;



constructor TStudentInfo.Load(var S: TStream);
begin
  Inherited Init;
  S.Read(TransferRecord, SizeOf(TransferRecord));
end;

procedure TStudentInfo.Store(var S: TStream);
begin
  S.Write(TransferRecord, SizeOf(TransferRecord));
end;

Procedure TStudentInfo.Print;
var str: string;
    LinkRecord: TLinkRecord;
Begin
  with LinkRecord do
  begin
       PName := @TransferRecord.Name;
       PMark := TransferRecord.Mark;
  end;
  FormatStr (str,'  %-24s%-4d', LinkRecord);
  writeln (str);
End;

procedure TStudentsColl.Error (Code, Info: Integer);
begin
     write ('Error: ');
     case Code of
      coIndexError: writeln ('Index out of range.');
      coOverflow  : writeln ('Collection overflow.');
     end;
end;

{$i sortfunc.inc}

function TStudentsColl.Compare (Key1, Key2: Pointer): Integer;
begin
     Compare := StrICmp (
                  PStudentInfo(Key1)^.TransferRecord.Name,
                  PStudentInfo(Key2)^.TransferRecord.Name
                );
end;


begin
  RegisterType (RStudentsColl);
  RegisterType (RStudentInfo);
end.
</code>

<code pascal>
{
    Keywords: OOP, Collection, Database

    Программа является базой данных на основе коллекций.
    Используются операции добавления, редактирования, удаления, просмотра, поиска в коллекции,
    сохранения и загрузки коллекции.

    Примечание: программу несложно изменить для использования интерфейса Turbo Vision.

    Romtek (c) May 2005
  }

uses crt, objects, drivers, strings, StudObj;

const
  db_file = 'stud_db.dat';
  maxitems = 9;
  OptionsList: array [1..maxitems] of string[30] = (
    'Load collection from file',
    'Save collection to file',
    'View collection',
    'Add record',
    'Edit record',
    'Delete record',
    'Search record in collection',
    'Best students',
    'Quit from program'
  );

var
  Created,
  Quit: boolean;
  option: integer;



procedure AbortMsg (msg: string);
 { Вывести сообщение об ошибке и выйти из программы }
begin
     writeln (msg);
     halt;
end;


procedure LoadCollection;
 { Загрузка сохраненной ранее коллекции из бинарного файла коллекции }
var
  FS: TBufStream;
begin
  FS.Init (db_file, stOpen,1024);
  if FS.Status <> stOK then
     AbortMsg ('File not found.'); { Файл не найден }
  PC := PStudentsColl (FS.Get); { Вставить коллекцию из файла  }
  FS.Done;
  if FS.Status <> stOK then
     AbortMsg ('Error of loading collection.');
    { Произошла ошибка чтения коллекции. Подробности искать в справке по 'stXXX' }

  writeln;
  writeln ('Collection is loaded successfully.');  { Сообщение об успешно загруженной коллекции }
  readln;
end;



procedure SaveCollection;
 { Сохранить коллекцию в файл }
var
  FS: TBufStream;
begin
  FS.Init (db_file, stCreate,1024); { Открываем файл коллекции на создание }
  FS.Put (PC); { Вставляем коллекцию в файл }
  FS.Done; { Закрываем работу с потоком }
  if FS.Status <> stOK then
     AbortMsg ('Error while saving collection!'); { Произошла ошибка при сохранении коллекции }

  writeln;
  writeln ('Collection is stored successfully.');  { Сообщение об успешно сохраненной коллекции }
  readln;
end;


procedure ViewCollection (C: PCollection);
procedure CallPrint (P : PStudentInfo); far;
 { Обязательно должна присутствовать директива FAR !
   Кроме того, процедура должна быть вложенной, иначе возникнут проблемы. }
begin
  P^.Print;
end;
begin { Print }
  Writeln;
  Writeln;
  Writeln ('Student list:');
 { помощью итератора ForEach выводим информацию о каждом студенте }
  C^.ForEach (@CallPrint);
  readln;
end;


procedure PrintMatches (C: PCollection; _Mark: integer);
 { Подсчёт и вывод студентов, имеющих оценку свыше указанной _Mark }
var count: word;
procedure Match (P : PStudentInfo); far;
begin
     if PStudentInfo(P)^.TransferRecord.Mark >= _Mark then
     begin
          P^.Print;
          inc (count);
     end;
end;

begin { Print }
  count:=0;
  Writeln (#13#10'Students who have mark above ', _Mark,': ');
  C^.ForEach (@Match);
  writeln;
  Writeln ('Total: ', count);
  readln;
end;

procedure BestStudents;
begin
     PrintMatches (PC, 80); { Искать студентов, имеющих балл свыше 80 }
end;


procedure SearchRecord;
var
   P: PStudentInfo;
   i: integer;
   who: string;

 function Matches (Item: Pointer): Boolean; far;
 begin
     Matches := PStudentInfo (Item)^.TransferRecord.Name = Who;
 end;

begin
     write ('Look for student (name): '); readln (who);
     { Используйте итератор FirstThat, чтобы найти первую "карточку",
     удовлетворяющую условию }
     P := PC^.FirstThat (@Matches);
     i := PC^.IndexOf (P);
     if i >= 0 then
     begin
          writeln ('Student was found:');
          PStudentInfo(PC^.At(i))^.Print;
     end
     else writeln ('"', Who ,'" was not found.');
     readln;
end;

procedure AddRecord;
 { Добавление "карточки" в коллекцию  }
var
  SI: PStudentInfo;
  Rec: TRecord;
begin
     writeln('Enter some info about a student: ');

     SI := New (PStudentInfo, Init);  { Создаем "карточку" студента }
     with SI^.TransferRecord do
     begin
          write ('Name: ' : 8); readln (Name); { Вводим новые фамилию }
          write ('Mark: ' : 8); readln (Mark); { и оценку }
     end;
     PC^.Insert (SI);  { Вставляем данные о студенте в коллекцию }

     writeln;
     writeln ('Record stored successfully.'); { Сообщение об успешно добавленной "карточке" }
     readln;
end;


procedure EditRecord;
 { Редактировать заданную "карточку" студента }
var
  SI: PStudentInfo;
  Rec: TRecord;
  num: integer;
begin
     { Прежде чем заменять данные в "карточке" студента, надо ввести его номер в коллекции.
       Поэтому для начала нужно просмотреть список выбором 'View collection' }
     write ('Enter number of student in list: '); readln (num);

     SI := PC^.At (Pred (num)); { Присваиваем указатель на "карточку" студента под номером num-1.
     Не забывайте, что нумерация в коллекциях идет с нуля! }
     with SI^.TransferRecord do
     begin
          SI^.Print; { Показываем текущие данные из "карточки" студента }
          writeln;
          write ('Enter new name: '); readln (Name); { Вводим новые фамилию }
          write ('Enter new mark: '); readln (Mark); { и оценку }
     end;

     writeln;
     writeln ('Record stored successfully.'); { Сообщение об успешно измененной "карточке" }
     readln;
end;


procedure DeleteRecord;
 { Удаление "карточки" из коллекции }
var
  SI: PStudentInfo;
  Rec: TRecord;
  num: integer;
begin
     { Прежде чем удалять данные в "карточке" студента, надо ввести его номер в коллекции.
       Поэтому для начала нужно просмотреть список выбором 'View collection' }
     write ('Enter number of student in list: '); readln (num);

     PC^.AtDelete (Pred (num));

     writeln;
     writeln ('Record deleted successfully.'); { Сообщение об успешно измененной "карточки" }
     readln;
end;


procedure ShowMenu;
 { Построение меню и выбор операции }
var
   i: integer;
begin
     clrscr;
     writeln ('-= Menu =-': 46);

     for i := 1 to maxitems do
     begin
          writeln;
          writeln (i: 26, '.  ', OptionsList[i]); { Вывод элементов меню }
     end;

     writeln;
     writeln;
     write ('Enter option: ': 43); readln (option);
end;


BEGIN
  Created := true;

  PC:=New(PStudentsColl,Init(50,10));
  { Создание коллекции в памяти из 50 объектов.
    Цифра 10 говорит о том, что если попытаемся вставить в коллекцию больше чем 50 объектов,
    то станем увеличивать начальный размер (50) на 10, пока не хватит места для всех объектов. }
  if PC = Nil then { Увы, не хватило памяти... Выходим. }
     exit;

  repeat
        ShowMenu;
    { Выбор опции }
        case option of
          1: if PC^.Count = 0 then { Коллекция пуста }
                LoadCollection;
          2: SaveCollection;
          3: ViewCollection (PC);
          4: AddRecord;
          5: EditRecord;
          6: DeleteRecord;
          7: SearchRecord;
          8: BestStudents;
          9: Quit := true; { Получили команду выйти из программы }
        end;
  until Quit;

  { Освободить память от коллекции }
  Dispose(PC, Done);
END.
</code>

**Полная** версия находится в файле.

{{pascal:oop:stud_db.zip|Скачать stud_db.zip}}

===== База данных на примере коллекции с интерфейсом Turbo Vision =====

Программа основана на программе выше, только добавлен интерсфейс Turbo Vision (как среда BP7). Аналогично, рассмотрены и реализованы следующие операции: добавление, редактирование, удаление, просмотр, поиск в коллекции, сохранения и загрузки коллекции в файл.

{{pascal:oop:tv_stud.zip|Скачать tv_stud.zip}}