THVDataSet - A Complete Delphi DataSet Based on Stream

• Download source - 1.6 MB

Introduction

I've seen too many dataset descendants, but what I really wanted was a stream based dataset, offering full capabilities such as insert, edit, delete and locate operations and supporting blob formats too. And more, accessing external XML files in order to load and save its blob contents too.

My component (called THVDataSet) implements the basic functions of a common TDataSet object, or at least what should be expected - and this is not so common to find - and it was done in a transparent way using practically all basic virtual known DBTables methods, but in this current version, SQL statements are not supported.

The THVDataset class was initially based on two components written by Marco Cantu (link: http://www.marcocantu.com/code/md6htm/MdDataPack.htm#MdDsCustom.pas) which are TMdCustomDataSet and TMdDataSetStream. This site was the only one found which explains "in a useful way" the creation of datasets. Moreover, it explained very well how to develop a TDataSet descendant class based on TStream. But there are many things that are missing, such as locate and delete methods, for example, and more.

The supported types used by the THVDataSet component are:

• ftString;
• ftBoolean;
• ftSmallInt;
• ftWord;
• ftInteger;
• ftDate;
• ftTime;
• ftFloat;
• ftCurrency;
• ftDateTime;
• ftMemo;
• ftGraphic

The ftMemo and ftGraphic types are saved into an XML file.

So, what I want to bring here is a complete implementation from his original source, but rewriting almost all of its source just to increase performance and best techniques to encapsulate all of the required steps to generate a complete dataset descendant based on a stream database file, where all data is persisted on its file, and also accessed by a header file where it builds (at design and run time) all desired fields at overridden InternalInitFieldDefs procedure (from TDataSet class contained at DB.pas). It internally uses another class also developed by me called THVParser, which has the purpose of loading all defined fields from its header file, computing offset from that fields to finally get the record size, that is, the size of the actual data, used in the overridden GetRecordSize function (TDataSet ancestor). See an example of that overridden procedure below:

procedure THVDataSet.InternalInitFieldDefs;
var
  fHeaderFileName: string;
  parser: THVParser;
begin
  fHeaderFileName := ChangeFileExt(FTableName, '.header');
  
  if not FileExists(fHeaderFileName) then
    raise EHVDataSetError.create('The header file must be created before!');

  Settings.LoadFromFile(fHeaderFileName);
  parser := THVParser.Create;
  
  try
    parser.ParseSQL(Settings.Script);
    parser.MyDataSet := Self;
    parser.CreateTempDefinitionTable;
    FRecordSize  := parser.TmpFieldOffset;
    FFieldOffset := parser.FieldOffset;
    Self.fScript := Settings.Script;
  finally
    FreeAndNil(parser);
  end;
end;

Background

Here is a little summary of this THVDataSet implementation, that is a custom stream file based dataset one, that is, basically all features it can support. I made a comparison between TMdDataSetStream and THVDataSet classes below:

First Step - Infrastructure

As we've seen before, one of the most important parts of this THVDataSet is a internal class called THVParser. It has the goal of executing a parsing process, for example, to read and interpret fields definitions from a string and compile to a TClientDataSet object, to finally create their fields dynamically, either in design or runtime, providing all traditional dataset information such as Name, Type, Size and Required (necessary to TFieldDef) data. So, this class THVParser will get this our table definition list and process it to create a valid header for our table. It is a simple process, and in order to accomplish its work, a string list will be generated as an log output.

Now we are going to demonstrate a useful table fields creator app, our THVDataSet wizard! It will help the developer to manage, compile and save that tables header in order to assign its file to a "TableName" property from THVDataSet component at Object Inspector and it's ready to go!

The THVDataSet Fields Creator Wizard App

The first thing to do is defining some fields and creating the header file. It is because of the creation process of the component. The THVDataSet firstly loads its header file in order to create a valid corresponding database file. Notice that we are creating for this example a table with four fields (numbering position order from 0 to 3). Please see these pictures below to ease the understanding of fields creation process and consequently its header file, through this wizard:

As we can see above, a header file (selected in printscreen) was created, named as "customer.header" file. All header files will have that extension. Now we can finally create that table, just assigning in THVDataSet´s TableName method. So, we will show a THVDataSet´s demo working and renderizing DBGrid´s cells by DrawColumnCell event just to paint them to draw its memo and graphic data, calling FillRect procedure from TCanvas class internally.

Finally, we are going to show the respective code responsible to deal with both ftMemo and ftGraphic blob types in a real entire demo application, implemented by THVDataSet component:

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  HVDataSet1.TableName := ExtractFilePath(Application.ExeName) + 'customer';
  HVDataSet1.Active := True;
  edtPath.Text := HVDataSet1.TableName;
  CheckBox1.Checked := True;

  for i := 0 to HVDataSet1.FieldCount - 1 do
    DBGrid1.Columns[i].Font.Size := 8;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  i: integer;
begin
  HVDataSet1.Active := CheckBox1.Checked;

  for i := 0 to HVDataSet1.FieldCount - 1 do
    DBGrid1.Columns[i].Font.Size := 8;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  R: TRect;
  Bmp: TBitmap;
begin
  R := Rect;
  Dec(R.Bottom, 2);

  if Column.Field = HVDataSet1.FieldByName('DS_MEMO') then
  begin

    DBGrid1.Canvas.FillRect(Rect);
    DrawText(DBGrid1.Canvas.Handle,
      PChar(HVDataSet1.FieldByName('DS_MEMO').AsString),
      Length(HVDataSet1.FieldByName('DS_MEMO').AsString), R,
      DT_WORDBREAK);
  end;

  if Column.Field = HVDataSet1.FieldByName('FT_PHOTO') then
  begin
    DBGrid1.Canvas.FillRect(Rect);
    Bmp := TBitmap.Create;
    try
      if (HVDataSet1.GetImageBlob) then
      begin
        Bmp.Assign(HVDataSet1.BlobImage.Picture.Bitmap);
        DBGrid1.Canvas.StretchDraw(Rect, Bmp);
       end;
    finally
      FreeAndNil(Bmp);
    end;
  end;        
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  HVDataSet1.SaveBlobMemo('DS_MEMO', Memo1.Text);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not OpenPictureDialog1.Execute then Exit;
  HVDataSet1.SaveBlobImage('FT_PHOTO',  OpenPictureDialog1.FileName);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  HVDataSet1.EmptyTable;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  sw : TStopWatch;
begin
  sw := TStopWatch.Create;
  try
    sw.Start;
    HVDataSet1.Delete;
  finally
    sw.Stop;
    Label3.Caption := 'Elapsed ' + sw.FormatMillisecondsToDateTime(sw.ElapsedMilliseconds);
    FreeAndNil(sw);
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  HVDataSet1.DeleteBlobMemo('DS_MEMO');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  HVDataSet1.DeleteBlobImage('FT_PHOTO');
end;

Running the Application

Now we are going to run a THVDataSet component using that header created above, it is also contains ftMemo (DS_MEMO) and ftGraphic (FT_PHOTO) fields, and the DBGrid renderizes all that data formatted and displayed in a practical and efficient way, treating that code on OnDrawColumnCell event.

The XML File as Persistence to Blob

Both Memo and Graphic types will be saved on a XML file. They also will be accessed in order to load and read its contents through the process of serialization and desserialization.

The THVDataSet internally uses two free components to make this process easier and transparent to build a flexible solution to implement these features to that. There are the TNativeXml (http://www.simdesign.nl/nativexml.html) and TXMLSerializer (https://www.lmd.de/downloads/tutorials/serializerpack/index.htm?NG.Serialization.Xml.TXmlSerializer.htm). They play an important role to load, save and transform contents of memos and graphics to XML, even graphic data will be converted to XML data, in other words they are just strings. Graphic data represents hundreds of characters. Please see this explanation below to understand about them:

Both classes also use a third class created by me called TCollectionDataSet, which has the purpose of interacting XML collections as they were datasets, emulate something like "XML TDataSet". It is because of that hard manipulation of nodes and trees, so implementing them into a derived TDataSet class improves much better this communication and interaction between them. The component uses another class called THVBlobStream (that inherits from TMemoryStream) to provide an interface to operate between blob and dataset types. See a snippet of that source below:

function THVDataSet.CreateBlobStream(Field: TField;
  Mode: TBlobStreamMode): TStream;
begin
  Result := THVBlobStream.Create(Field as TBlobField, Mode);
end;

procedure THVBlobStream.LoadBlobData;
var
  i: integer;
  s: string;
begin
  if (FDataSet.BlobFieldFlag = '') then
    raise EHVDataSetError.Create
    ('Error. There is no primary key field to assign to blob fields.');

  FDataSet.CreateBlobObjects;

  for i := 0 to FDataSet.FieldCount - 1 do
  begin
    case FDataSet.Fields[i].DataType of
      ftMemo: begin
               FDataSet.bImageRenderedOK := false;
                if collectionDataSet.Locate('BlobFieldName;FieldName;FieldValue',
                  VarArrayOf([FDataSet.Fields[i].FieldName, FDataSet.BlobFieldFlag, 
                         FDataSet.fieldByName(FDataSet.BlobFieldFlag).AsString]), []) then
                  begin
                    s := collectionDataSet.fieldByName('MemoContents').AsString;
                    Self.Write(s[1], Length(s) * SizeOf(Char));
                    self.Position := 0;
                    FModified := False;
                  end;
              end;
      end;
  end;
end;

function THVBlobStream.Read(var Buffer; Count: Integer): Longint;
begin
  Result := inherited Read(Buffer, Count);
  FOpened := True;
end;

procedure THVBlobStream.SaveBlobData;
var
  i: integer;
  Doc: TNativeXml;
  Writer: TsdXmlObjectWriter;
  FImage: TImage;
  auxStr: string;
begin
  if (FModified) then
  begin
    FDataSet.CreateBlobObjects;

    for i := 0 to FDataSet.FieldCount - 1 do
    begin
      case FDataSet.Fields[i].DataType of
        ftGraphic: begin
                     if (FDataSet.GraphicFile = '') then Continue;

                     if collectionDataSet.Locate('BlobFieldName;FieldName;FieldValue',
                       VarArrayOf([FDataSet.Fields[i].FieldName, FDataSet.BlobFieldFlag, 
                        FDataSet.fieldByName(FDataSet.BlobFieldFlag).AsString]), []) then
                         collectionDataSet.Delete;

                     FImage := TImage.Create(nil);
                     try
                       FImage.Parent := nil;
                       FImage.Picture.Bitmap.Create;
                       FImage.Visible := True;

                       FImage.Picture.Bitmap.LoadFromFile(FDataSet.GraphicFile);
                       FDataSet.GraphicFile := '';
                       //FImage.Picture.Bitmap.LoadFromFile(fAuxFile);

                       // Create XML document with root named "Root"
                       Doc := TNativeXml.CreateName('Root');
                       try
                         // Start XML conversion, from image to XML
                         Doc.XmlFormat := xfReadable;
                         // Create Object writer
                         Writer := TsdXmlObjectWriter.Create;
                         try
                           // Write the image object as child of the XML document's root node
                           Writer.WriteComponent(Doc.Root, FImage, nil);
                         finally
                           Writer.Free;
                         end;

                         auxStr := StringReplace(Doc.WriteToString, 
                                  '<TImage>','<TImage Name="Image1">',[rfReplaceAll]);
                         FImage.Visible := True;
                       finally
                         Doc.Free;
                       end;
                     finally
                       FImage.Free;
                     end;

                     blobMetaDatas.AddEx(FDataSet.Fields[i].FieldName, FDataSet.BlobFieldFlag,
                       FDataSet.fieldByName(FDataSet.BlobFieldFlag).AsString, auxStr, '');

                     with TXMLSerializer.Create(nil) do
                     begin
                       XMLSettings.WellFormated := true;
                       StorageOptions := [soIncludeObjectLinks, soSortProperties];
                       SpecialClasses := [scTCollection];
                       SaveObject(blobMetaDatas, 'BlobMeta');
                       SaveToFile(FDataSet.XMLFile);
                     end;
                   end;

        ftMemo: begin
                  if (FDataSet.BlobValue = '') then Exit;

                  if collectionDataSet.Locate('BlobFieldName;FieldName;FieldValue',
                    VarArrayOf([FDataSet.Fields[i].FieldName, FDataSet.BlobFieldFlag, 
                      FDataSet.fieldByName(FDataSet.BlobFieldFlag).AsString]),[]) then
                      collectionDataSet.Delete;

                  blobMetaDatas.AddEx(FDataSet.Fields[i].FieldName, FDataSet.BlobFieldFlag,
                    FDataSet.fieldByName(FDataSet.BlobFieldFlag).AsString, '', 
                             FDataSet.BlobValue);

                  with TXMLSerializer.Create(nil) do
                  begin
                    XMLSettings.WellFormated := true;
                    StorageOptions := [soIncludeObjectLinks, soSortProperties];
                    SpecialClasses := [scTCollection];
                    SaveObject(blobMetaDatas, 'BlobMeta');
                    SaveToFile(FDataSet.XMLFile);
                  end;
                end;
        end;
    end;
  end;

  FModified := False;
end;

function THVBlobStream.Write(const Buffer; Count: Integer): Longint;
begin
  Result := inherited Write(Buffer, Count);
  FModified := True;
end;

procedure THVBlobStream.Deserialize(aSender, aObject: TObject;
  aObjectName: string; aNode: IXMLNode; var aSkipObject: boolean);
var
  i: Integer;
begin
  for i := 0 to aNode.ChildNodes.Nodes['customdata'].ChildNodes.count - 1 do
  begin
    blobMetaDatas.Add;
  end;
end;

And see the code responsible for creating those objects into the component:

procedure THVDataSet.CreateBlobObjects;
begin
  if Assigned(blobMetaDatas) then
    FreeAndNil(blobMetaDatas);

  blobMetaDatas := TBlobMetaDatas.Create(TBlobMetaData);

  XMLFile := (ExtractFileName(AnsiUpperCase(TableName))+ '.xml');
  if FileExists(XMLFile) then
  begin
    with TXMLSerializer.Create(nil) do
    begin
      XMLSettings.WellFormated := true;
      SpecialClasses := [scTCollection];
      LoadFromFile(XMLFile);
      OnStartObjectLoad := Deserialize;
      LoadObject(blobMetaDatas, 'BlobMeta');
    end;
  end;

  if Assigned(collectionDataSet) then
  begin
    collectionDataSet.Active := False;
    FreeAndNil(collectionDataSet);
  end;

  collectionDataSet := TCollectionDataSet.Create(nil);
  collectionDataSet.Collection := blobMetaDatas;
  collectionDataSet.Active := True;
end;

Finally, there are also two classes developed by me called TBlobMetaData that inherits from TCollectionItem and TBlobMetaDatas that inherits from TCollection.

They are used to read and load in memory all records that have some type of blob - they are used to be loaded (serialized) and deserialized through the TXMLSerializer class, and they are also used by the class TNativeXml to transform between images and text. Finally, the THVDataSet calls TNativeXml component to convert string to TImage, which is required to display the images in a DBGrid, for example.

To conclude, the TBlobMetaData and TBlobMetaDatas classes also use the TCollectionDataSet class to implement standard functions of a dataset, such as locate (this method was overwritten), etc., acting like a normal table.

type

  TBlobMetaData = class (TCollectionItem)
  private
    FBlobFieldName: string;
      FFieldName: string;
    FFieldValue: string;
    FGraphicContents: string;
      FMemoContents: string;
  published
    property BlobFieldName: string read FBlobFieldName write FBlobFieldName;
      property FieldName: string read FFieldName write FFieldName;
    property FieldValue: string read FFieldValue write FFieldValue;
    property GraphicContents: String read FGraphicContents write FGraphicContents;
      property MemoContents: String read FMemoContents write FMemoContents;
  end;

  TBlobMetaDatas = class (TCollection)
  private
    function  GetItem(Index: Integer): TBlobMetaData;
    procedure SetItem(Index: Integer; AObject: TBlobMetaData);
  public
    function Add: TBlobMetaData;
    function AddEx(BlobFieldName : string; FieldName: string; FieldValue: string; 
                   GraphicContents: string; MemoContents: string): TBlobMetaData;
    property Item[Index: Integer]: TBlobMetaData read GetItem;
    procedure Delete(Index: Integer);
 end;

{ TBlobMetaDatas }

function TBlobMetaDatas.Add: TBlobMetaData;
begin
  Result := inherited Add as TBlobMetaData;
end;

function TBlobMetaDatas.AddEx(BlobFieldName, FieldName, FieldValue,
  GraphicContents, MemoContents: string): TBlobMetaData;
begin
  Result := inherited Add as TBlobMetaData;
  Result.BlobFieldName := BlobFieldName;
  Result.FieldName := FieldName;
  Result.FieldValue := FieldValue;
  Result.GraphicContents := GraphicContents;
  Result.MemoContents := MemoContents;
end;

procedure TBlobMetaDatas.Delete(Index: Integer);
begin
  inherited Delete(Index);
end;

function TBlobMetaDatas.GetItem(Index: Integer): TBlobMetaData;
begin
  Result := inherited Items[Index] as TBlobMetaData;
end;

procedure TBlobMetaDatas.SetItem(Index: Integer; AObject: TBlobMetaData);
begin
  inherited Items[Index] := AObject;
end;

Above, we can see some pictures from Notepad++ that shows an XML File created by THVDataSet containing blob formats.

Some Prints from Blob Types Demos

There are more some prints from samples created by me to illustrate the blob support of this component, it follows below:

New Functions to Blob Management

The component also implemented four important functions to encapsulate several lines of code necessary to manipulate the blob process, they are functions to save and clear the both blob types listed above. So they are:

Conclusion

This is a component that has never been seen before on the web, in these circumstances, about inheriting from TDataSet, persisting database file on TStream and supporting blob types on external XML files. This is also a new approach to manage blob fields, interacting with pure XML and all is provided by this THVDataSet component.

It can be customized to add or edit new functionalities to that, that is to make this component better.

A sample project along with this component has been included to test it successfully.

History

• 7^th February, 2017: Initial post