Как писать DataSet
	Банников Н.А.	www.stikriz.narod.ru	Почта	На главную страницу

1Как писать DataSet.

Практически каждый начинающий программист рано или поздно задается вопросом о том, насколько быстро будет работать тот или иной компонент доступа к БД на большом наборе данных. Если Вы зададите такой вопрос в конференциях для программистов, то будьте уверены, что Вам скажут, что у Вас что-то не так в постановке задачи, что большой набор на клиента тащить не стоит. Это совершенно верно. Но, бывают такие задачи, в которых нет возможности ограничить набор данных выкачиваемых на клиентскую часть. Типичный случай такой задачи – это построение отчетов. Например, распечатать отчет по недвижимости в крупной компании или оплаты за телефонные звонки. Еще один пример – это работа сервера приложений. Хоть он и может не открывать большие наборы данных, но при большом количестве подключенных клиентов объем открытых единовременно данных может превзойти все возможности железа. Что же происходит в программе, когда Вы открываете набор данных? Дело в том, что практически все компоненты доступа к БД, такие как IBX, FIBPlus и т.д. представляют собой как бы электронную таблицу, и все данные, которые поступили с сервера, хранятся в оперативной памяти. Понятно, что при больших объемах память расходуется не рационально. Например, пользователь работает с одной строкой, но в памяти хранятся все данные.В результате, программе начинает остро нехватать оперативной памяти, и работа компьютера замедляется. Если использовать компоненты наподобие FIBQuery, то затрудняется навигация в обоих направлениях, нельзя использовать сетки данных. Поэтому, мне было интересно поэкспериментировать с альтернативным способом хранения данных в DataSet, а именно хранить данные в файле на диске, а не в оперативной памяти. И, похоже, что это верное решение.

Год назад в одном из проектов я переходил от компонентов доступа IBX к FIBPlus. Это стоило мне двух месяцев работы. Чтобы такого впредь не повторялось, нужно было сделать так, чтобы сам DataSet не зависил от методов доступа к БД. В результате появился набор DataSet ов от электронной таблицы до Query, у которого механизм доступа к данным в БД вынесен в отдельный компонент. Этот компонент я назвал Fetcher. Теперь можно было наследовать Fetcher для разных библиотек доступа. Если нужно сменить сервер или компоненты доступа, то нужно было только удалить все фечеры и поставить новые. Все же Fild ы, на которые завязано до 90% кода работы с DataSet оставались нетронутыми.

Когда я уже писал эту статью, то выслал некоторым моим друзьям почитать предварительную версию. В результате, получил еще одну бесценную идею, которая потребовала переписать все заново, но результат стоил такой работы. Идея состоит в том, чтобы вынести механизм хранения данных в DataSet в отдельный класс. Теперь, мы можем сменить сам принцип хранения данных на новый не меняя DataSet. Т.е. даже во время выполнения программы перейти от хранения в памяти к хранению на диске и наоборот. Теперь DataSet становится универсальным компонентом управления хранилищами и не только данных. А чего именно – это Вам решать.

В данной статье мы рассмотрим построение потомка TDataSet, который будет хранить набор данных в файле на диске. Заодно рассмотрим основные принципы построения любого потомка TDataSet, так что Вы сможете строить свои компоненты и по другому принципу. Основная идея – это выделить как самостоятельный компонент сам набор данных, т.е. сделать класс на манер TMemoryDataSet, только хранящий данные в файле. И сделать абстрактный класс для скачивания данных с любого сервера. В свою очередь, наследники от этого компонента  смогут работать с разными серверами. Для примера, рассмотрим доступ через FIBPlus

Беглое знакомство с TDataSet.

Начиная с Delphi3, любой набор данных в Delphi порождается от абстрактного класса TDataSet. Это позволяет создавать свои классы доступа к данным для различных серверов. Вам достаточно переопределить 23 метода, чтобы DataSet смог нормально функционировать. Все методы можно разделить на несколько групп.

Методы буферизации.

// Выделяет новый буфер в памяти, размером с запись и возвращает указатель на него

function AllocRecordBuffer: PChar;

// Освобождает буфер, переданный в параметре

procedure FreeRecordBuffer(var Buffer: PChar);

// Метод получения записи. Довольно сложный механизм – рассмотрим далее

function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;

// Метод забивает новую запись значениями по умолчанию, например, нулями или NULL

procedure InternalInitRecord(Buffer: PChar);

// Возвращает размер записи

function GetRecordSize: Word;

// Отдает данные текущей записи, принадлежащие Field в буфере Buffer

function GetFieldData(Field: TField; Buffer: Pointer): Boolean;

// Данные из буфера Buffer помещает в текущую запись, в место, отведенное для Field

procedure SetFieldData(Field: TField; Buffer: Pointer);

Методы навигации по набору данных.

procedure InternalFirst;

procedure InternalLast;

Методы изменения данных.

procedure InternalAddRecord(Buffer: Pointer; Append: Boolean);

procedure InternalDelete;

procedure InternalPost;

Методы работы с закладками.

procedure GetBookmarkData(Buffer: PChar; Data: Pointer);

function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;

procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);

procedure SetBookmarkData(Buffer: PChar; Data: Pointer);

// …GoToBookmark и …SetToRecord переходят на выставленную закладку, но первый

// получает указатель на закладку, а второй – буфер данных поля.

// Обычно, в конце этого буфера закладка J

procedure InternalGotoBookmark(Bookmark: Pointer);

procedure InternalSetToRecord(Buffer: PChar);

Методы управления набором данных.

procedure InternalClose;

procedure InternalOpen;

// Обработчик исключительной ситуации.

procedure InternalHandleException;

// Этот метод создает набор FieldDefs.

procedure InternalInitFieldDefs;

function IsCursorOpen: Boolean;

Дополнительные (необязательные) методы.

function GetRecordCount: Integer;

// RecNo – это номер активной записи по порядку в нашем DataSet с текущей фильтрацией

// или без неё. Хотя, Вам никто не мешает сделать как угодно.

function GetRecNo: Integer;

// Присваивание RecNo приведет к установки активной записи, у которой указанный RecNo.

procedure SetRecNo(Value: Integer);

Все эти методы виртуальные, все их нужно перегрузить в секции protected. Бывает, что методы Get/SetFieldData выносят в секцию public.

Основные положения и стратегия разработки.

Мы будем писать TUnDataSet – это DataSet, на манер электронной таблицы. Его особенностью будет то, что он не может самостоятельно хранить какие бы то ни было данные. Для этого у него есть отдельный класс TUnCustomRecordSet, который является абстрактным, чтобы мы могли переопределить механизмы хранения данных так, как нам нужно. Этот класс TUnDataSet перед открытием должен получить извне. Для этого, мы создадим еще один класс TUnCustomRecordSetDispatcher, который тоже является абстрактным. Мы будем наследовать диспетчер так, чтобы он мог давать RecordSet нужного типа. На весь модуль данных, или даже на всю программу будет достаточно одного диспетчера, который будет всем DataSet_ам раздовать RecordSet_ы. Как только мы напишем эти классы, у нас будет полнофункциональная электронная таблица. Далее, мы будем наследовать наш TUnDataSet так, чтобы у него появился как поле механизм доступа к данных, т.е. Fetcher. Сам Fetcher тоже будет абстрактным. Наследуя его, мы сможем получить разные механизмы доступа к данных под нужный сервер БД. Вот упрощенная схема того, что мы должны сделать.

Record Set.

Задача, которая стоит перед TUnCustomRecordSet – хранить данные TDataSet_а. Этот класс должен дать удобный интерфейс TDataSet_у. Но, уже сейчас можно определить несколько ключевых моментов, которые позволят нам часть реализации все-таки вынести в наш абстрактный класс. Во первых, это применение TList в качестве списка с указателями на структуры ключей. TList, по моему опыту, достаточно эффективно работает с количеством указателей где-то до единиц миллионов. Этого достаточно. Вот, объявление структур:

// Описание для Blob

TUnBlobQuad = packed record

 QuardHight: Integer;

 QuardLow: Cardinal;

end;

// Структура, организующая закладку

TUnBookmarkInfo = packed record

 BookmarkData: Integer;

 BookmarkFlag: TBookmarkFlag;

end;

PUnBookmarkInfo = ^TUnBookmarkInfo;

// Структура, инкапсулирующая данные о записи. В потомках мы будем её расширять

TUnRecordData = packed record

 Id: Integer;        // Код

 Position: Integer;  // Позиция в списке

end;

PUnRecordData = ^TUnRecordData;  // Указатель на эту структуру

Вот объявление TUnCustomRecordSet:

TUnCustomRecordSet = class(TObject)

 private

  FListId: TList;

  FDataSet: TDataSet;

  FNextId: Integer;

 protected

  FData: TList;

  function GetItem(Index: Integer): PUnRecordData;

  function GetCapasity: Integer;

  procedure SetCapasity(Value: Integer); virtual;

  function GetCount: Integer;

  procedure DeleteItem(P: Pointer); virtual; abstract;

  function CreateItem: Pointer; virtual; abstract;

 public

  constructor Create;

  destructor Destroy; override;

  procedure Clear;

  procedure Open; virtual;

  procedure Pack; virtual;

  procedure RecalckPosition;

  procedure Delete(Index: Integer);

  function AddNewItem(Buffer: Pointer; Position: Integer): PUnRecordData; virtual;

  procedure CopyRecordToBuffer(Item: Pointer; Buffer: PChar); virtual; abstract;

  procedure CopyBufferToRecord(Item: Pointer; Buffer: PChar); virtual; abstract;

  function FindRecordByID(ID: Integer): PUnRecordData;

  procedure Exchange(Index1, Index2: Integer);

  function GetStream(AsCopy: boolean): TStream; virtual; abstract;

  property Item[Index: Integer]: PUnRecordData read GetItem; default;

  property Count: Integer read GetCount;

  property Capasity: Integer read GetCapasity write SetCapasity;

  property DataSet: TDataSet read FDataSet write FDataSet;

end;

Полный текст реализации я здесь приводить не буду, а рассмотрю только ключевые моменты. Ключевые данные, т.е то, что нужно хранить для организации работы набора данных, а это что-то вроде TUnRecordData  будет храниться в списке FData в порядке сортировки и FListId в порядке создания, т.е. сортировка не будет менять местами указатели в этом списке, а при удалении в список FListId на места удаленных строк будет записываться nil. FNextId хранит Id следующей структуры. При каждой вставке записи FNextId увеличивается на единицу. Реальное создание ключевой структуры происходит в методах:

procedure DeleteItem(P: Pointer); virtual; abstract;

function CreateItem: Pointer; virtual; abstract;

Это абстрактные методы, т.к. структура, объявленная в этом модуле, а именно TUnRecordData нам недостаточна в потомках, и там мы будем создавать немного другие структуры, но повторяющие нашу TUnRecordData по всем полям, которые в ней объявлены, т.е. первые поля такие же, а расширяющие - после них. Это нам даст некоторую гибкость в реализации, т.к. TUnCustomRecordSet будет работать с этими структурами по своему, а потомки – по своему.

Однако, уже сейчас понятно, что нужно сделать при вставке записи, поэтому мы можем реализовать метод AddNewItem:

function TUnCustomRecordSet.AddNewItem(Buffer: Pointer; Position: Integer): PUnRecordData;

begin

 Result:=PUnRecordData(CreateItem);

 FListId.Add(Result);  // Добавили в список по Id

 Result.Id:=FNextId;

 Inc(FNextId, 1);

 if FData.Count = Position then   

  Position:=FData.Add(Result)  // Добавим вконец

 else

  FData.Insert(Position, Result);  // Вставим

 Result.Position:=Position;

end;

При удалении:

procedure TUnCustomRecordSet.Delete(Index: Integer);

var Id: Integer;

begin

 Id:=PUnRecordData(FData[Index]).Id;

 DeleteItem(FData[Index]);

 FData.Delete(Index);

 FListId[Id-Low(Integer)]:=nil;

end;

Поиск записи по его Id – это нужно для реализации работы закладки:

function TUnCustomRecordSet.FindRecordByID(ID: Integer): PUnRecordData;

begin

 try

  Result:=FListId[ID-Low(Integer)];

 except on Exception do

  Result := nil; // Это произойдет, если Id выйдет за пределы допустимого, но этого не произойдет J

 end;

end;

Теперь, поговорим о том, как эти RecordSet создавать. Дело в том, что DataSet его создавать не должен, т.к. мы делаем универсальный, который может и в памяти, и на диске хранить данные, соответственно, у него они могут быть разные RecordSet_ы. Способ, который мы будем использовать – это небольшой элемент, скорее, аспектного программирования. Мы создадим компонент – фабрику классов, которая будет property у нашего DataSet_а. Эта фабрика и будет давать разные RecordSet_ы. Вот объявление абстрактного класса TUnCustomRecordSetDispatcher:

TUnCustomRecordSetDispatcher = class(TComponent)

 private

  FCapasity: Integer;

 public

  function GetRecordSet(DataSet: TDataSet): TUnCustomRecordSet; virtual; abstract;

 published

  property Capasity: Integer read FCapasity write FCapasity;

end;

Собственно, предварительная подготовка закончена. Можно думать о самом DataSet. Стоит только заметить, что т.к. понятия «друзья класса» в паскале реализуется помещением классов в один модуль, то, ясное дело, диспетчер для нужного RecordSet должен быть в одном модуле с самим RecordSet.

TUnDataSet.

Итак, данные хранятся в наследнике от TUnCustomRecordSet. Значит, этот TUnCustomRecordSet должен присутствовать в TUnDataSet. Чтобы его получить при открытии, нам нужно попросить его от потомка TUnCustomRecordSetDispatcher, значит TUnCustomRecordSetDispatcher должен быть property в нашем TUnDataSet. Для хранения Blob применяется потомок от Tstream. Не принято сразу выкачивать данные для Blob. Обычно это делается по мере необходимости. Возможно, Вы бы предпочли хранить данные BLOB на клиенте для всех строк, которые хотя бы раз были считаны в DataSet. Но, наученный горьким опытом, я даже не буду пытаться сделать так. Мы просто предусмотрим пару событий, в которых можно будет получить данные для блоб и, если пользователь их изменил, записать их в БД и забыть. Вот объявление нашего TUnDataSet:

Никогда не мешает создать свой тип Exception, хотя бы для того, чтобы любители case в Except могли воспользоваться им.

   TUnDbException = class(Exception);

Это указатели на массивы со смещениями данных полей в записи, список указателей на Blob данные:

TOffsetsArray = array[0..MaxListSize] of Word;

POffsetsArray = ^TOffsetsArray;

TStreamsArray = array[0..MaxListSize] of TStream;

PStreamsArray = ^TStreamsArray;

Метод для получения и записи Blob:

TUnGetSetBlob = procedure(DataSet: TDataSet; Field: TBlobField; var Data: TStream) of Object;

Событие – сигнал:

TUnDbNotifyEvent = procedure(DataSet: TDataSet) of Object;

Объявление типа функции для сравнения данных во время сортировки:

TCompareData = function(Buffer1, Buffer2: PChar): Integer of Object;

Обьявление типа функции для сравнения полей:

TUnFieldCompare = function(ListFields: TList; P1, P2: Pointer; I1, I2: Integer): Integer of Object;

И наконец, сам TUnDataSet:

   TUnDataSet = class(TDataSet)

    private

     FRealRecordPos: Integer;       // Номер активной записи

     FListBlobs: TList;             // Список блобов

     FIsFetchAll: boolean;           // Признак, что все сфечено[1]

     FListOffsets: POffsetsArray;   // Список смещений данных полей в буфере

     FMemBlobArray: PStreamsArray;  // Список потоков для Blob

     FOldBlobArray: PStreamsArray;  // Список потоков для Blob перед редактированием

     FIsDeleted: boolean;           // Флаг необходимости упаковки данных, т.е. удалялись строки.

     FOnGetBlob: TUnGetSetBlob;

     FOnSetBlob: TUnGetSetBlob;

     FGetFieldDef: TUnDbNotifyEvent;   // Указатель на процедуру определения списка полей

            …

     FShowCursor: boolean;

     FCursor: TCursor;

     FRecordSetDispatcher: TUnCustomRecordSetDispatcher; // Поле с диспетчером

     FRecordSet: TUnCustomRecordSet;     // Поле с RecordSet, который даст диспетчер при открытии

     FIsOpen: boolean;

            …

     procedure _CheckPositionCursor(CurPos: Integer);

     function _RecordFilter: Boolean;

     function _GetActiveRecBuf(var RecBuf: PChar): Boolean;

     function _FindFieldData(Buffer: Pointer; Field: TField): Pointer;

     procedure _CheckWriteMode;

     procedure _FetchAll;

     procedure _SetBlobsToServer;

     procedure _ClearFieldsWitoutOwner;

            …

     procedure SetRecordPosition(AValue: Integer);

    protected

     FBufferSize: Word;             // Размер буфера с записью

     FRecordSize: Word;             // Размер записи без учета информации о закладке

     FClearBuffer: PChar;           // Буфер с данными по умолчанию. Используется для инициализации новой записи

     FIsRunAllFetcher: boolean;         // Флаг для сигнализации о процессе феча в потомках

     FisSetFieldsFromFetcher: boolean; // Флаг того, что филды предоставил потомок

     FBlobPresents: boolean;           // Флаг, что есть блобы

     procedure _CheckNextFetch; virtual;

     procedure _OpenData; virtual;

     procedure _InternalAddFetchData(Buffer: PChar);

     procedure Clear; virtual;

     procedure ClearBlobBufers; virtual;

     function AllocRecordBuffer: PChar; override;

     procedure FreeRecordBuffer(var Buffer: PChar); override;

     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;

     procedure InternalInitRecord(Buffer: PChar); override;

     function GetRecordSize: Word; override;

     procedure InternalFirst; override;

     procedure InternalLast; override;

     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;

     procedure InternalDelete; override;

     procedure InternalPost; override;

     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;

     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;

     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;

     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;

     procedure InternalGotoBookmark(Bookmark: Pointer); override;

     procedure InternalSetToRecord(Buffer: PChar); override;

     procedure InternalClose; override;

     procedure InternalOpen; override;

     procedure InternalHandleException; override;

     procedure InternalInitFieldDefs; override;

     function IsCursorOpen: Boolean; override;

     function GetRecordCount: Integer; override;

     function GetRecNo: Integer; override;

     procedure SetRecNo(Value: Integer); override;

     function GetIsLoaded: boolean; virtual;

     property RecordPos: Integer read FRealFRecordPos write SetRecordPosition;

     property OnGetBlob: TUnGetSetBlob read FOnGetBlob write FOnGetBlob;

     property OnSetBlob: TUnGetSetBlob read FOnSetBlob write FOnSetBlob;

    public

     constructor Create(AOwner: TComponent); override;

     destructor Destroy; override;

      …

     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;

     procedure SetFieldData(Field: TField; Buffer: Pointer); override;

      …

     property IsLoaded: boolean read GetIsLoaded;

     property IsDeleted: boolean read FIsDeleted;

      …

    published

     property Cursor: TCursor read FCursor write FCursor;

     property ShowCursor: boolean read  FShowCursor write FShowCursor;

     property RecordSetDispetcher: TUnCustomRecordSetDispatcher read FRecordSetDispatcher write FRecordSetDispatcher;

…

   end;

Для начала, рассмотрим наши 23 виртуальных метода, которые обязательно нужно реализовать при создании своего потомка TDataSet. Самое простое и очевидное – это выделение, освобождение и инициализация буфера:

function TUnDataSet.AllocRecordBuffer: PChar;

begin  // Выделение буфера для DataSet

 GetMem(Result, FBufferSize);

end;

procedure TUnDataSet.FreeRecordBuffer(var Buffer: PChar);

begin   // Уничтожение буфера

 FreeMem(Buffer, FBufferSize);

 Buffer := nil;

end;

procedure TUnDataSet.InternalInitRecord(Buffer: PChar);

begin // Очистим шаблоном

 Move(FClearBuffer^, Buffer^, FBufferSize);

end;

function TUnDataSet.GetRecordSize: Word;

begin // Размер записи без учета данных закладки

 Result:=FRecordSize;

end;

Обратите внимание, что при открытии DataSet, вы могли бы инициализировать буфер FClearBuffer значениями по умолчанию. Можно и нулями, но могут быть проблемы с датой и временем. FRecordSize будет инициализирована в методе InternalInitFieldDefs. Самый сложный метод во всем этом тексте – это GetRecord. Особенно сложно, т.к. его практически невозможно дебажить, т.к. он вызывается постоянно, когда перерисовывается DbGrid, например.

function TUnDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;

var Accept: Boolean;

begin   // Дать запись.

  Result := grOk;

  Accept := True;

  _CheckPositionCursor(RecordPos);

  case GetMode of

   gmPrior: begin   // Предыдущую

      if RecordPos <= 0 then

       begin  // Предыдущих нет

        Result:=grBof;

        RecordPos:=-1;

       end

      else

       begin

        repeat // Пролистаем отфильтрованые

         RecordPos:=RecordPos-1;

         if Filtered then Accept := _RecordFilter;

        until Accept or (RecordPos < 0);

        if not Accept then

         begin

          Result := grBOF;

          RecordPos := -1;

        end;

       end;

    end;

   gmCurrent: begin  // Текущую

     if (RecordPos < 0) or (RecordPos >= RecordCount) then

      Result:=grError

     else if Filtered then

      if not _RecordFilter then Result := grError;

    end;

   gmNext: begin  // Следующую

      if (RecordPos >= RecordCount - 1) then

        Result:=grEof

      else

       begin

        repeat  // Пролистаем отфильтрованные

         RecordPos:=RecordPos+1;

         if Filtered then Accept := _RecordFilter;

        until Accept or (RecordPos > RecordCount - 1) or FIsFetchAll;

        if not Accept then

         begin

          Result := grEOF;

          RecordPos := RecordCount - 1;

         end;

       end;

    end;

  end;

  if Result = grOk then

   begin // Проверки на здравый смысл

    if RecordPos >= FRecordSet.Count then

     FRecordSet.CopyRecordToBuffer(FRecordSet[RecordPos-1], Buffer)

    else

     begin

      if (RecordPos < 0) and (RecordCount > 0) then RecordPos := 0;

       FRecordSet.CopyRecordToBuffer(FRecordSet[RecordPos], Buffer);

     end;

   end

  else

   if (Result = grError) and DoCheck then

    DatabaseError(str_No_Record);

end;

Абсолютно тривиальный код:

procedure TUnDataSet.InternalFirst;

begin

 RecordPos:=-1;

end;

procedure TUnDataSet.InternalLast;

begin

 if not FIsFetchAll then

  _FetchAll; // Т.е. если не все данные с сервера поступили в DataSet, то загружаем все.

 FRealRecordPos:=RecordCount;

end;

При добавлении новой записи, само действие по добавлению мы может поручить RecordSet, но ему только нужно указать позицию, куда нужно вставить запись.

procedure TUnDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);

begin  // Добавить строку данных

 if Append then

  begin

   FRecordSet.AddNewItem(Buffer, FRecordSet.Count);

   InternalLast;

  end

 else

  FRecordSet.AddNewItem(Buffer, RecordPos);

end;

Удаление, тоже производит RecordSet, но ему, опять, нужно передать позицию строки, которую нужно удалить.

procedure TUnDataSet.InternalDelete;

var Index: Integer;

begin // Удалить запись

 if RecordPos < 0 then

  Index:=0

 else if RecordPos > RecordCount - 1 then

  Index:=RecordCount - 1

 else

  Index:=RecordPos;

 FRecordSet.Delete(Index);

 RecordPos:=FRealRecordPos; // Передернем затвором :-)

 FIsDeleted:=true; // Да, строки удалялись

 FRecordSet.RecalckPosition;

end;

Post может быть после редактирования или после вставки, поэтому, нам нужно сначала определить что именно происходит. Если была вставка, то нужно вызвать InternalAddRecord и передать этому методу активный буфер (строки в RecordSet, пока, нет !), а если было редактирование, то просто записать данные.

procedure TUnDataSet.InternalPost;

var RecData: Pointer;

    Index: Integer;

begin // Запостим

 if (State <> dsInsert) then

  begin

   if RecordPos >= FRecordSet.Count then

    Index:=RecordPos-1

   else

    Index:=RecordPos;

   RecData:=FRecordSet[Index];

   if State = dsEdit then

     FRecordSet.CopyBufferToRecord(RecData, ActiveBuffer);

  end

 else

  InternalAddRecord(ActiveBuffer, Eof);

 _SetBlobsToServer;

end;

Закладка будет хранится после данных, т.е. буфер с данными, который будет записываться в RecordSet. Здесь мы будем вольно обращаться с указателями. Если кого-то это смущает, то советую почитать соответствующую литературу. Но сам принцип прост. Если Вы к адресу, который хранится в указателе прибавляете 1, то это значит, что полученное число указывает на один байт дальше. Методы работы с закладками:

procedure TUnDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);

begin // Прочитать данные закладки

 Move(PUnBookmarkInfo(Buffer + FRecordSize)^.BookmarkData, Data^, BookmarkSize);

end;

procedure TUnDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);

begin  // Записать данные закладки

 if Data <> nil then

  PUnBookmarkInfo(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;

end;

function TUnDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;

begin // Прочитать флаг закладки

 Result:=PUnBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag;

end;

procedure TUnDataSet.SetBookmarkFlag(Buffer: PChar;

  Value: TBookmarkFlag);

begin  // Установить флаг закладки

 PUnBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag:=Value;

end;

Здесь, если закладка не найдена, то можно было бы и ругнутся. Если Вам это нужно, то сделайте свои изменения в коде.

procedure TUnDataSet.InternalGotoBookmark(Bookmark: Pointer);

var Rec: PUnRecordData;

    SavePos: Integer;

    Accept: Boolean;

begin // Перейти на закладку

  Rec:=FRecordSet.FindRecordByID(Integer(Bookmark^)); // Вот зачем они эти Id нужны...

  if (Rec <> nil) then

   begin

    Accept:=True;

    SavePos:=RecordPos;

    try

     RecordPos:=Rec.Position;

     if Filtered then Accept:=_RecordFilter;

    finally

      if not Accept then RecordPos:=SavePos;

    end;

   end;

end;

procedure TUnDataSet.InternalSetToRecord(Buffer: PChar);

begin

 InternalGotoBookmark(@PUnBookmarkInfo(Buffer+ FRecordSize)^.BookmarkData);

end;

Методы открытия / закрытия DataSet:

procedure TUnDataSet.InternalClose;

begin // Закрыть набор

 FIsOpen:=false;

 Clear; // Очищаемся

 FRecordSet.Free;

 FRecordSet:=nil;

 FBufferSize:=0;

 RecordPos:=-1;

end;

Открытие набора значительно интереснее. Во первых, мы проверяем, есть ли диспетчер, который даст нам RecordSet, и если он не указан, то дальнейшая работа невозможна. Если указан, то просим создать диспетчер. Далее, важный момент – это создать Field_ы. Наконец, идет реальное открытие данных.

procedure TUnDataSet.InternalOpen;

begin // Открыть таблицу

 if FRecordSetDispatcher = nil then

  raise TUnDbException.Create(str_Not_Set_RecorsSetDisp);

 FRecordSet:=FRecordSetDispatcher.GetRecordSet(Self);

 FIsRunAllFetcher:=false;

 RecordPos:=-1;

 FIsFetchAll:=false;

 InternalInitFieldDefs; // Создаем поля

 _ClearFieldsWitoutOwner;

 FSortBy:='';

 _OpenData;

 if FieldCount = 0 then

  CreateFields; // Если полей нет, то создаем их на лету

 BindFields(true);

 FIsDeleted:=false; // Пока, ничего не удалялось

end;

Не мудрствуя долго, определяем последний обработчик исключительной ситуации:

procedure TUnDataSet.InternalHandleException;

begin

 Application.HandleException(Self);

end;

Инициализация полей во время открытия набора данных достаточно громоздкий метод. Ключевые моменты – это то, что Field_ы могут быть разные. Первое и очевидное, что программист их сам поставит на форму и настроит, но их может предоставить и Fetcher, если они не заданы явно. Далее, нужно пройтись по всем им и посчитать размер буфера под хранение их данных, и заполнить TFieldDef.

procedure TUnDataSet.InternalInitFieldDefs;

var I: Integer;

    Fld: TField;

    Offs: Integer;

    BlobCount: Integer;

begin  // Определить поля

 BlobCount:=0;

 try

  FieldDefs.Clear; // Очистим

  Offs:=0;

  if Assigned(FGetFieldDef) then

   begin  // Если можно, то попросим поля

    FGetFieldDef(Self);

    FisSetFieldsFromFetcher:=true;

   end;

  // Инициализируем размер списков

  if FListOffsets <> nil then

   FreeMem(FListOffsets);

  GetMem(FListOffsets, FieldCount*Sizeof(Word));

  for I:=0 to FieldCount-1 do

   begin // Пройдемся по полям

    Fld:=Fields[I];

    TFieldDef.Create(FieldDefs, Fld.FieldName, Fld.DataType, Fld.Size, false, I+1);

    FListOffsets[I]:=Offs;

    Offs:=Offs+Fld.Size+SizesFields[Byte(Fld.DataType)];

    if Fld.IsBlob  then

     begin   // Если оно blob, то добавим в список blob ов

      FListBlobs.Add(Fld);

      BlobCount:=BlobCount+1;

     end;

   end;

  FRecordSize:=Offs; // Посчитаем размер записи

  FBufferSize:=FRecordSize+Sizeof(TUnBookmarkInfo); // Размер буфера

  GetMem(FClearBuffer, FBufferSize); // Получили пустой буфер

  FillChar(FClearBuffer^, FBufferSize, 0); // Заполнили нулями

  // Установили размер списков для Blob полей

  if FMemBlobArray <> nil then

   FreeMem(FMemBlobArray);

  GetMem(FMemBlobArray, FieldCount*Sizeof(TStream));

  FillChar(FMemBlobArray^, FieldCount*Sizeof(TStream), 0);

  if FOldBlobArray <> nil then

   FreeMem(FOldBlobArray);

  GetMem(FOldBlobArray, FieldCount*Sizeof(TStream));

  FillChar(FOldBlobArray^, FieldCount*Sizeof(TStream), 0);

 finally

  FBlobPresents:=BlobCount > 0;

 end;

end;

Метод получения количества строк, конечно, элементарен. Количество возвращает класс, который их хранит, т.е. RecordSet:

function TUnDataSet.GetRecordCount: Integer;

begin

 _CheckPositionCursor(RecordPos);

  Result:=FRecordSet.Count;

end;

RecNo, как мы договорились – это номер строки. Но, особенность состоит в том, что номер должен начинаться не с нуля, а с единицы:

function TUnDataSet.GetRecNo: Integer;

begin // Дать номер по порядку активной записи

 CheckActive;

 _CheckPositionCursor(RecordPos);

 UpdateCursorPos;

 if (RecordPos = -1) and (RecordCount > 0) then

  Result:= 1

 else

  Result:=RecordPos+1;

end;

procedure TUnDataSet.SetRecNo(Value: Integer);

begin  // Номер записи в списке - установить, т.е. перейти к записи с этим номером

  CheckBrowseMode;

  if (Value < 1) then

    Value := 1

  else if Value > RecordCount then begin

    InternalLast;

    Value := _Min(RecordCount, Value);

  end;

  if (Value <> RecNo) then begin

    DoBeforeScroll;

    RecordPos := Value - 1;

    Resync([]);

    DoAfterScroll;

  end;

end;

И последний метод:

function TUnDataSet.IsCursorOpen: Boolean;

begin

 Result:=FIsOpen;

end;

Чтобы увидеть полную картину, Вам лучше обратится к исходным текстам, которые идут с этой статьей.

Дополнительная функциональность.

Дополнительной функциональностью можно назвать сортировку по одному или нескольким столбикам и намного быстрый Locate, который использует метод половинного деления, если DataSet уже отсортирован по нужным столбикам. Эта тема выходит за рамки данной статьи, но Вы можете посмотреть прилагаемые тексты, чтобы разобраться самостоятельно как именно это можно сделать. Давайте рассмотрим RecordSet, способный хранить данные в файле и диспетчер для него.

TUnStreamRecordSet

Во первых, мы можем, наконец-то определить структуру ключа так, как он есть на самом деле:

  // Структура, инкапсулирующая данные о записи.

  TUnStrRecordData = packed record

   Id: Integer;        // Код

   Position: Integer;  // Позиция в списке

   Offset: Longint;    // Смещение в файле

  end;

  PUnStrRecordData = ^TUnStrRecordData;  // Указатель на эту структуру

Вот объявление класса:

TUnStreamRecordSet = class(TUnCustomRecordSet)

 private

  FStream: TStream;           // Поток, в котором будут хранится данные

  FCashMode: boolean;

  FBufferSize: Integer;       // Размер буфера в строках

  FNextOffset: Longint;       // Смещение для новой записи

  FCash: PChar;               // Буфер данных

  FCashOfset: Longint;        // Смещение, которое отображает буфер данных в байтах

  FCashWriten: boolean;       // В буфер писали данные ?

  FCashSize: Integer;         // Размер буфера данных в байтах

  FRecordSize: Integer;       // Размер записи

  FDispetcher: TUnStreamRecordSetDispatcher;

  CopyBufferToRecordMethod: TCopyBufferRecordSet; // Указатель на метод

  CopyRecordToBufferMethod: TCopyBufferRecordSet; // Указатель на метод

  procedure CopyBufferToRecordWizBubber(Offset: Integer; Buffer: PChar);

  procedure CopyRecordToBufferWizBuffer(Offset: Integer; Buffer: PChar);

  procedure CopyBufferToRecordBubber(Offset: Integer; Buffer: PChar);

  procedure CopyRecordToBufferBuffer(Offset: Integer; Buffer: PChar);

  procedure ResetCash;

  procedure ClearCash;

  procedure CheckFileOffset(AOffset: Longint);

 protected

  procedure DeleteItem(P: Pointer); override;

  function CreateItem: Pointer; override;

 public

  constructor Create;

  destructor Destroy; override;

  function AddNewItem(Buffer: Pointer; Position: Integer): PUnRecordData; override;

  procedure CopyRecordToBuffer(Item: Pointer; Buffer: PChar); override;

  procedure CopyBufferToRecord(Item: Pointer; Buffer: PChar); override;

  function GetStream(AsCopy: boolean): TStream; override;

  procedure Open; override;

end;

Этот RecordSet может использовать буфер для работы с потоком. Надо сказать, что буфер не должен быть слишком маленьким, но и не очень большим. Во первых, маленький буфер все-таки провоцирует слишком частое обращение к диску, но большой буфер тоже плохо, и не только потому, что занимает большой размер памяти. Дело в том, что если отсортировать строки по другому, то велика вероятность, что в буфере, считанном с диска будет мало строк, необходимых в данный момент, или даже одна строка. Из-за этого явления, происходит частая продувка буфера, а это уже излишне частое чтение с диска, причем не как в первом варианте – маленького буфера, а большого. Лучше провести несколько опытов для подбора оптимального размера, но по опыту я знаю, что буфер не должен превышать 64 Кб, а лучше – 4 - 32  Кб. Тогда и становится возможным параллельность работы с диском, т.к. UDMA может писать и читать с диска не задействуя процессор, правда, это становится эффективным, в основном, для серверов приложений, где используются нити во многопользовательском режиме работы. Для начала, рассмотрим методы выделения и освобождения памяти под запись:

function TUnStreamRecordSet.CreateItem: Pointer;

begin

 GetMem(Result, Sizeof(TUnStrRecordData));

end;

procedure TUnStreamRecordSet.DeleteItem(P: Pointer);

begin

 FreeMem(PUnStrRecordData(P));

end;

Как видите, код так же тривиален, как и для TUnDataSet. Вот как переопределен метод создания новой записи:

function TUnStreamRecordSet.AddNewItem(Buffer: Pointer; Position: Integer): PUnRecordData;

begin

 Result:=inherited AddNewItem(Buffer, Position);

 PUnStrRecordData(Result).Offset:=FNextOffset;

 Inc(FNextOffset, FRecordSize);

 CopyBufferToRecord(Result, Buffer);

end;

Здесь, ключевым моментом является то, что запись под ключ имеет поле  Offset, которое хранит смещение от начала файла, куда записана запись. Вот методы записи-чтения буферов:

procedure TUnStreamRecordSet.CopyRecordToBuffer(Item: Pointer; Buffer: PChar);

begin

 CopyRecordToBufferMethod(PUnStrRecordData(Item).Offset, Buffer);

end;

procedure TUnStreamRecordSet.CopyBufferToRecord(Item: Pointer; Buffer: PChar);

begin

 PUnBookmarkInfo(Buffer + DataSet.RecordSize)^.BookmarkFlag:=bfCurrent;

 PUnBookmarkInfo(Buffer + DataSet.RecordSize)^.BookmarkData:=PUnStrRecordData(Item).Id;

 CopyBufferToRecordMethod(PUnStrRecordData(Item).Offset, Buffer);

end;

Здесь главное – это то, что методы чтения-записи вызываются через указатель, а не напрямую. Эти указатели заполняются во время открытия набора в зависимости от режима работы, т.е. если через буфер, то одни, а если без буфера – то другие. Вот их реализация:

// Методы реальной работы со стримом

procedure TUnStreamRecordSet.CopyBufferToRecordWizBubber(Offset: Integer; Buffer: PChar);

begin  // Без буфера

 FStream.Position:=Offset;

 FStream.Write(Buffer^, FRecordSize);

end;

procedure TUnStreamRecordSet.CopyRecordToBufferWizBuffer(Offset: Integer; Buffer: PChar);

begin  // Без буфера

 FStream.Position:=Offset;

 FStream.Read(Buffer^, FRecordSize);

end;

procedure TUnStreamRecordSet.CopyBufferToRecordBubber(Offset: Integer; Buffer: PChar);

begin   // С буфером

 CheckFileOffset(Offset);

 Move(Buffer^, (FCash + (Offset - FCashOfset))^, FRecordSize);

 FCashWriten:=true;

end;

procedure TUnStreamRecordSet.CopyRecordToBufferBuffer(Offset: Integer; Buffer: PChar);

begin  // С буфером

 CheckFileOffset(Offset);

 Move((FCash + (Offset - FCashOfset))^, Buffer^, FRecordSize);

end;

Если без буфера, то там все тривиально, а если с буфером, то нам постоянно нужно следить, что смещение не вышло за пределы буфера. Вот как это можно сделать:

procedure TUnStreamRecordSet.CheckFileOffset(AOffset: Longint);

begin // Проверить, что буфер не вышел за границы

 if AOffset > (FCashOfset + FCashSize - FRecordSize) then

  begin

   ResetCash;

   FCashOfset:=AOffset;

   if FStream.Size < (FCashOfset + FCashSize) then

    FStream.Size:=FCashOfset + FCashSize;

   FStream.Position:=FCashOfset;

   FStream.Read(FCash^, FCashSize);

  end

 else if AOffset < FCashOfset then

  begin

   ResetCash;

   FCashOfset:=AOffset - FCashSize + FRecordSize;

   if FCashOfset < 0 then

    FCashOfset:=0;

   FStream.Position:=FCashOfset;

   FStream.Read(FCash^, FCashSize);

  end;

end;

Здесь нет ничего сложного, просто нужно аккуратно следить за смещением. Рассматриваются два варианта: буфер выше, и буфер ниже смещения. Если выше или ниже, то нужно продуть буфер – метод ResetCash, передвинуть смещение стрима, и задуть буфер. Вот метод продувки буфера:

procedure TUnStreamRecordSet.ResetCash;

begin

 if FCashWriten then

  begin

   FStream.Position:=FCashOfset;

   FStream.Write(FCash^, FCashSize);

   FCashWriten:=false;

  end;

end;

Здесь, если была запись в буфер, то он сбрасывается на диск, если нет, то ничего не делается. Остальной код тривиален, и Вы можете посмотреть его самостоятельно. Теперь, определим фабрику классов для TUnStreamRecordSet.

TUnStreamRecordSetDispatcher = class(TUnCustomRecordSetDispatcher)

 private

  FBufferSize: Integer;

  FCashMode: boolean;

  FInMemory: boolean;

  FOnGetTempStream: TGetSetTempFile;

  FOnCloseTempStream: TGetSetTempFile;

 public

  function GetRecordSet(DataSet: TDataSet): TUnCustomRecordSet; override;

 published

  property BufferSize: Integer read FBufferSize write FBufferSize;

  property CashMode: boolean  read FCashMode write FCashMode;

  property InMemory: boolean read FInMemory write FInMemory;

  property OnGetTempStream: TGetSetTempFile read FOnGetTempStream write FOnGetTempStream;

  property OnCloseTempStream: TGetSetTempFile read FOnCloseTempStream write FOnCloseTempStream;

end;

Мы видим, что в фабрике есть настройки RecordSet, т.е. Вы можете либо раз и навсегда определить эти настройки для всех RecordSet во время разработки, либо переопределять их перед открытием TUnDataSet. Не забудем еще, что фабрика должна быть в одном модуле с RecordSet, тобы иметь полный доступ к его полям. Вот реализация метода получения RecordSet_а:

function TUnStreamRecordSetDispatcher.GetRecordSet(DataSet: TDataSet): TUnCustomRecordSet;

begin

 Result:=TUnStreamRecordSet.Create;

 if FInMemory or not Assigned(FOnGetTempStream) then

  TUnStreamRecordSet(Result).FStream:=TMemoryStream.Create

 else

  FOnGetTempStream(DataSet, TUnStreamRecordSet(Result).FStream);

 Result.DataSet:=DataSet;

 Result.Capasity:=Capasity;

 TUnStreamRecordSet(Result).FcashMode:=FCashMode;

 TUnStreamRecordSet(Result).Fdispetcher:=Self;

 TUnStreamRecordSet(Result).FBufferSize:=FBufferSize;

end;

Мы видим, что фабрике нужен обработчик на получение TStream. Если его нет, то создается TMemoryStream. Вообще, на больших наборах данных его использовать не рекомендуется, да и не затем мы делали такой RecordSet, чтобы все хранить в памяти, т.к. если сделать специализированный, который будет хранить строки в памяти, а не в TStream, то он будет намного эффективнее, чем в TMemoryStream. Далее, создается сам RecordSet, настраивается, согласно настройкам фабрики и отдается TUnDataSet_у. Все. Собственно, на этом можно было бы закончить. Но, давайте проведем тестирование. А что же мы получили?

Стресс тест.

Создадим небольшую программулинку для проверки нашего TUnDataSet_а. Вот как могла бы выглядеть форма:

На Add:

procedure TForm1.Button5Click(Sender: TObject);

var I: Integer;

begin

 UnDataSet1.DisableControls;

 for I:=1 to SpinEdit1.Value do

  begin

   UnDataSet1.Append;

   UnDataSet1a.Value:=I;

  end;

 UnDataSet1.EnableControls;

end;

На Finde:

procedure TForm1.FindClick(Sender: TObject);

begin

 UnDataSet1.Locate(Edit2.Text, Edit4.Text, []);

end;

На Sort:

procedure TForm1.Button4Click(Sender: TObject);

begin

 UnDataSet1.SortOnFields(Edit2.Text, false, false, false);

end;

Сделаем поле с именем a – целое число. Добавьте еще пару-тройку полей по своему усмотрению. Тестовая платформа: AMD Athlon 1000, 256 Mb RAM, IBM 5400 20 Gb. Добавление 1 000 000 записей – 7 секунд. Сортировка 100 000 записей – 15 секунд (сравните – сортировка миллиона записей занимает уже несколько минут…). Поиск в 1 000 000 записей не более 2 секунд. Буфер и Capasity были установлены в 100. Общий размер записи был 46 байт.

Благодарности:

            Особая благодарность Naviy за идею выделения RecordSet в отдельный класс.

            Дмитриию Коннову за тестирование компонентов и предложения по архитектуре.

            Дмитрий Шумко - портирование  до пятой версии Delphi.

Продолжение следует. В следующей статье мы подробно познакомимся с методами работы с базами данных, в частности, создадим TUnFectherDataSet и Fetcher для него, который можно наследовать для любых БД.

     Банников Н.А. www.stikriz.narod.ru почта 2003 г.