Знакомство с коллекциями , OOП на примере базы данных

[Romtek]

Знакомство с коллекциями (одно из применений ООП)

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

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

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

Для того, чтобы работать с базой данных все знают, что нам нужен массив, хранящий эти записи:

type
     TDataArr = array [1..N] of TRecord;
     DB: file of TDataArr; { описание файловой переменной для работы с файлом }

Для коллекции же необходимо создать объект, в котором будет находиться переменная (в данном случае TransferRecord)
типа TRecord (запись):

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

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

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

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

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

Здесь сравнение ведётся по имени студентов с помощью функции сравнения строк StrICmp (файл sortfunc.inc),
без учёта регистра букв. Можно сортировать также по оценке.

В разделе инициализации модуля следует зарегистрировать типы RStudentsColl и RStudentInfo, чтобы не
возникало ошибок при работе с потоками:

  RegisterType (RStudentsColl);
  RegisterType (RStudentInfo);

Используемые в коллекции функции и процедуры:
At() - указатель на объект в коллекции
Insert() - добавление в коллекцию
AtDelete() - удаление объекта из коллекции
FirstThat - итератор для поиска по заданному условию.

Сам код программы я старался прокоментировать как можно более подробно.

  {
    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.

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 (RSortedCollection);}
  RegisterType (RStudentsColl);
  RegisterType (RStudentInfo);
 
end.

Полная версия находится в прикреплённом файле.
Прикреплённый файлstud_db.zip (4.28 Кбайт, скачиваний: 290)

[Romtek]

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

Программа основана на программе из сообщ. №1 (без интерфейса)
Аналогично, рассмотрены реализованы операции: добавление, редактирование, удаление, просмотр, поиск в коллекции, сохранения и загрузки коллекции.
Прикреплённый файлtv_stud.zip (5.3 Кбайт, скачиваний: 292)