THVDataSet - 一个基于流的完整Delphi DataSet
5.00/5 (3投票s)
学习如何实现一个真正的基于流文件的DataSet后代，支持blob等功能
引言
我见过太多数据集的后代类，但真正想要的是一个基于流的数据集，它提供插入、编辑、删除和定位等完整功能，并且支持 BLOB 格式。更进一步，还能访问外部 XML 文件来加载和保存其 BLOB 内容。
我的组件（称为 THVDataSet）实现了常见 TDataSet 对象的基本功能，或者至少是应该预期的功能——而这并不常见——它是以一种透明的方式实现的，几乎使用了所有基本的虚拟已知 DBTables 方法，但在当前版本中，不支持 SQL 语句。
THVDataset 类最初基于 Marco Cantu 编写的两个组件（链接：http://www.marcocantu.com/code/md6htm/MdDataPack.htm#MdDsCustom.pas），它们是 TMdCustomDataSet 和 TMdDataSetStream。这是我找到的唯一一个“有益地”解释数据集创建的网站。此外，它很好地解释了如何开发一个基于 TStream 的 TDataSet 后代类。但是还有很多东西缺失，例如 locate 和 delete 方法，等等。
THVDataSet 组件支持的类型有：
ftString;ftBoolean;ftSmallInt;ftWord;ftInteger;ftDate;ftTime;ftFloat;ftCurrency;ftDateTime;ftMemo;ftGraphic
ftMemo 和 ftGraphic 类型被保存在 XML 文件中。
因此，我想在这里带来的是对其原始源代码的完整实现，但重写了几乎所有的源代码，以提高性能和采用最佳技术来封装生成基于流数据库文件的完整数据集后代所需的所有步骤，其中所有数据都持久保存在其文件中，并且可以通过头文件进行访问，该头文件在设计时和运行时构建所有所需的字段，通过重写 TDataSet 类（位于 DB.pas 中）的 InternalInitFieldDefs 过程。它内部使用了我开发的另一个类 THVParser，其目的是从头文件中加载所有定义的字段，计算这些字段的偏移量，最终得到记录的大小，即实际数据的大小，用于重写的 GetRecordSize 函数（TDataSet 的祖先）。下面是一个该重写过程的示例。
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;
背景
以下是 THVDataSet 实现的一个小总结，这是一个自定义流文件数据集，也就是说，基本上它支持的所有功能。我在下面比较了 TMdDataSetStream 和 THVDataSet 类。
| 功能 | TMdDataSetStream | THVDataSet |
| Insert | X | X |
| 未使用。 | X | X |
| Post | X | X |
| 删除 | X | |
| 定位 | X | |
| 创建表（如果不存在） | X | |
| 清空表 | X | |
| 高效的字段布局存储（头文件） | X | |
| 创建表的脚本处理 | X | |
| 生成表创建的向导 | X |
第一步 - 基础设施
正如我们之前所见，THVDataSet 中最重要的部分之一是一个名为 THVParser 的内部类。它的目标是执行一个解析过程，例如，读取和解释 string 中的字段定义，并将其编译成 TClientDataSet 对象，最终动态创建其字段，无论是在设计时还是运行时，提供所有传统的数据集信息，如 Name、Type、Size 和 Required（对 TFieldDef 是必需的）数据。所以，这个 THVParser 类将获取我们的表定义列表并进行处理，以创建我们表的有效头。这是一个简单的过程，为了完成它的工作，会生成一个 string 列表作为日志输出。
现在我们将演示一个有用的表字段创建应用程序，我们的 THVDataSet 向导！它将帮助开发者管理、编译和保存表头，以便在 Object Inspector 中将其文件分配给 THVDataSet 组件的 "TableName" 属性，然后就可以使用了！
THVDataSet 字段创建向导应用程序
首先要做的就是定义一些字段并创建头文件。这是因为组件的创建过程。THVDataSet 首先加载其头文件，以便创建一个有效的相应数据库文件。请注意，在本例中，我们创建了一个包含四个字段的表（按 0 到 3 的顺序编号）。请参阅下面的图片，以便更容易理解字段创建过程及其头文件，通过此向导。
如上所示，创建了一个头文件（在截图中标出），名为 "customer.header" 文件。所有头文件都将具有该扩展名。现在我们可以最终创建该表，只需在 THVDataSet 的 TableName 方法中分配即可。因此，我们将展示一个 THVDataSet 的演示，通过 DrawColumnCell 事件渲染 DBGrid 的单元格，以便绘制其 memo 和 graphic 数据，内部调用 TCanvas 类的 FillRect 过程。
最后，我们将展示负责处理 ftMemo 和 ftGraphic BLOB 类型的相应代码，在一个完整的演示应用程序中，由 THVDataSet 组件实现。
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;
运行应用程序
现在我们将运行一个使用上述头文件创建的 THVDataSet 组件，它还包含 ftMemo (DS_MEMO) 和 ftGraphic (FT_PHOTO) 字段，并且 DBGrid 以实用且高效的方式格式化和显示所有数据，在 OnDrawColumnCell 事件中处理该代码。
XML 文件作为 BLOB 持久化
Memo 和 Graphic 类型都将保存在 XML 文件中。它们也将通过 **序列化** 和 **反序列化** 过程被访问以加载和读取其内容。
THVDataSet 内部使用了两个免费组件来使这个过程更容易和透明，从而构建一个灵活的解决方案来实现这些功能。它们是 TNativeXml (http://www.simdesign.nl/nativexml.html) 和 TXMLSerializer (https://www.lmd.de/downloads/tutorials/serializerpack/index.htm?NG.Serialization.Xml.TXmlSerializer.htm)。它们在加载、保存和转换 memo 和 graphic 的内容到 XML 中起着重要作用，即使 graphic 数据也会被转换为 XML 数据，换句话说，它们只是 string。Graphic 数据代表成百上千个字符。请参阅下面的解释以了解它们。
| 类 | 描述 | 作者 |
|
| 它将图像转换为 XML，反之亦然。在 THVDataSet 中，它用于将 TImage 对象转换为 XML 并执行相反的过程。 | Nils Haeck |
|
| 它将所有 BLOB 数据保存到 XML 文件并重新加载它们。它使用序列化和反序列化技术。 | DragonSoft |
这两个类还使用我创建的第三个类 TCollectionDataSet，它的目的是像数据集一样与 XML 集合进行交互，模拟类似于 "XML TDataSet"。这是因为对节点和树的繁琐操作，因此将它们实现到派生的 TDataSet 类中可以更好地改善它们之间的通信和交互。该组件使用另一个名为 THVBlobStream 的类（继承自 TMemoryStream）来提供一个接口来操作 BLOB 和数据集类型。下面是该源代码的片段。
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;
请看负责在组件中创建这些对象的代码。
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;
最后，还有两个由我开发的类，名为 TBlobMetaData（继承自 TCollectionItem）和 TBlobMetaDatas（继承自 TCollection）。
它们用于读取和加载内存中所有具有某种 BLOB 类型的记录——它们用于被 TXMLSerializer 类加载（序列化）和反序列化，它们也用于 TNativeXml 类在图像和文本之间进行转换。最后，THVDataSet 调用 TNativeXml 组件将 string 转换为 TImage，这对于在 DBGrid 中显示图像是必需的。
总而言之，TBlobMetaData 和 TBlobMetaDatas 类也使用 TCollectionDataSet 类来实现数据集的标准功能，例如定位（此方法已被覆盖）等，就像普通表一样。
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;
上面，我们可以看到一些来自 Notepad++ 的图片，显示了一个由 THVDataSet 创建的包含 BLOB 格式的 XML 文件。
BLOB 类型演示的一些截图
还有一些我创建的示例截图，用于说明该组件的 BLOB 支持，如下所示。
BLOB 管理的新功能
该组件还实现了四个重要函数来封装处理 BLOB 过程所需的几行代码，它们是用于保存和清除上面列出的两种 BLOB 类型的函数。所以它们是：
| 函数 | 描述 | 使用示例 |
SaveBlobMemo | 保存 BLOB Memo | HVDataSet1.SaveBlobMemo('MYFIELDMEMO', Memo1.Text); |
SaveBlobImage | 保存 BLOB 图像 | if not OpenPictureDialog1.Execute then Exit; HVDataSet1.SaveBlobImage('MYFIELDGRAPHIC', OpenPictureDialog1.FileName); |
DeleteBlobMemo | 清除（删除）BLOB Memo | HVDataSet1.DeleteBlobMemo('MYFIELDMEMO'); |
DeleteBlobImage | 清除（删除）BLOB 图像 | HVDataSet1.DeleteBlobImage('MYFIELDGRAPHIC'); |
结论
这是一个在网络上从未见过的组件，在这种情况下，它继承自 TDataSet，将数据库文件持久化到 TStream，并且支持外部 XML 文件上的 BLOB 类型。这也是一种管理 BLOB 字段的新方法，与纯 XML 交互，所有这些都由这个 THVDataSet 组件提供。
它可以进行定制以添加或编辑新功能，从而使该组件更好。
已包含一个示例项目以及此组件，以成功对其进行测试。
历史
- 2017 年 2 月 7 日：初始发布