Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
 

Как писать DataSet

Банников Н.А.

  Исходние тексты примера датасета проверялись на Delphi3 и Delphi4, скорее всего, проблемм не будет и на Delphi5 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;
На Find:
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 для него, который можно наследовать для любых БД.

   Внимание! Запрещается перепечатка данной статьи или ее части без согласования с автором. Если вы хотите разместить эту статью на своем сайте или издать в печатном виде, свяжитесь с автором.
Автор статьи:  Банников Н.А.
  

Другие статьи Наверх


      Титульная страница Поиск, карта сайта Написать письмо