THVDataSet - A Complete Delphi DataSet Based on Stream
5.00/5 (3 votes)
Learn how to implement a real stream file based dataset descendant with blob support and much more
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:
| Feature | TMdDataSetStream | THVDataSet |
| Insert | X | X |
| Edit | X | X |
| Post | X | X |
| Delete | X | |
| Locate | X | |
| Create Table if it does not exists | X | |
| Empty Table | X | |
| Efficient Layout Fields Storage (header file) | X | |
| Script processing for table creation | X | |
| Wizard to generate table creation | X |
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:
| Class | Description | Author |
|
| It transform Images into XML and vice versa. In THVDataSet, it uses to transform a TImage object to XML and perform the reverse process. | Nils Haeck |
|
| It saves all both blob data to XML file and loads them again. It uses serialization and desserialization techniques. | DragonSoft |
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:
| Function | Description | Example of Usage |
SaveBlobMemo | Save Blob Memo | HVDataSet1.SaveBlobMemo('MYFIELDMEMO', Memo1.Text); |
SaveBlobImage | Save Blob Graphic | if not OpenPictureDialog1.Execute then Exit; HVDataSet1.SaveBlobImage('MYFIELDGRAPHIC', OpenPictureDialog1.FileName); |
DeleteBlobMemo | Clear (Remove) Blob Memo | HVDataSet1.DeleteBlobMemo('MYFIELDMEMO'); |
DeleteBlobImage | Clear (Remove) Blob Graphic | HVDataSet1.DeleteBlobImage('MYFIELDGRAPHIC'); |
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
- 7th February, 2017: Initial post