Delphi:将TComponent保存到Clientdataset blob字段

Question

我有一个TComponent类派生程序，如下所示，试图保存到clientdataset blob字段：(复制自互联网，到期学分)

type
  TSaveComponent = class(TComponent)
  private
    FFileName: string;
  public
    constructor Create(AFileName:string);
    destructor Destroy;
    procedure ReadFromBlobField1(AField: TField);
    procedure SaveToBlobField1(AField: TField);
  end;

... 

 constructor TSaveComponent.Create(AFileName: string);
 begin
   Name := Copy(Self.ClassName, 2, 99);
   FFileName := AFileName;  //-- disabled file saving for now
 end;

procedure TSaveComponent.ReadFromBlobField1(AField: TField);
var
  Stream: TStream;
  i: integer;
begin
  try
    Stream := TClientDataSet(AField.DataSet).CreateBlobStream(AField, bmRead);
    try
      {delete the all child components}
      for i := Self.ComponentCount - 1 downto 0 do
        Self.Components[i].Free;
      Stream.ReadComponent(Self);   //--ERROR here: Stream read error.
    finally
      Stream.Free;
    end;
  except
    on EFOpenError do {nothing};
  end;
end;

procedure TSaveComponent.SaveToBlobField1(AField: TField);
var
  Stream: TStream;
begin
  Stream := TClientDataSet(AField.DataSet).CreateBlobStream(AField,bmWrite);
  try
    Stream.WriteComponent( Self);
  finally
    Stream.Free;
  end;
end;

火鸟桌是..。

CREATE TABLE APPOBJECTS
(
  FORMDM_NAME varchar(31),
  OBJ_NAME varchar(40),
  OBJECT blob sub_type 1,
  CONSTRAINT UNQ_NAME UNIQUE (OBJ_NAME)
);

写信给db ..。

with dmMain.ClientDataSet2 do
begin
  if Locate('OBJ_NAME',GlobalSetting.Name,[]) then
    Edit
  else
    Append;
    FieldByName('OBJ_NAME').AsString := GlobalSetting.Name;
end;

GlobalSetting.SaveToBlobField1(dmMain.ClientDataSet2.FieldByName('OBJECT'));

dmMain.ClientDataSet2.Post;
dmMain.ClientDataSet2.ApplyUpdates(0);

(Globalsetting为TSaveComponent.)

从分局..。

with dmMain.ClientDataSet2 do
begin
  if Locate('OBJ_NAME',GlobalSetting.Name,[]) then
  begin
    GlobalSetting.ReadFromBlobField1(dmMain.ClientDataSet2.FieldByName('OBJECT'));
  end;
end;

问题: Stream.ReadComponent(self)行中的“流读取错误”始终存在。请问如何解决这个问题？

我可以确认保存组件的工作。我检查了表，并在GlobalSetting中看到了已发布的字段，只是不确定它是否是正确的格式。(如果需要，我可以显示十六进制表示)

编辑：整个解决方案使用IBX；对于DBExpress/Clientdataset组件，从blob字段读取流总是导致'Stream read error.'

Answer 1

Firebird表DDL应该定义如下(注: sub_type 0，而不是最初定义的1)：

CREATE TABLE APPOBJECTS
(
  FORMDM_NAME varchar(31),
  OBJ_NAME varchar(40),
  OBJECT blob sub_type 0,
  CONSTRAINT UNQ_NAME UNIQUE (OBJ_NAME)
);

真是个..。一直无视它。

参考资料：http://www.firebirdfaq.org/faq165/

Answer 2

正如注释中所述，您需要实现IStreamPersist。为了避免这种情况，您可以使用RTTI来存储和恢复属性。我为你们创造了一个例子：

首先，您需要一个可以持久化所有属性的类，以及它的值。

unit PropertyPersistU;

interface

uses
  System.Classes, System.RTTI;

type
  TPropertyPersist = class(TComponent, IStreamPersist)
  strict private
    class var RttiContext: TRttiContext;
    class function GetProperty(const aObject: TObject; const aPropertyName: string): TRttiProperty; overload; static;
  public
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
  end;

implementation

uses
  System.SysUtils;

class function TPropertyPersist.GetProperty(const aObject: TObject; const aPropertyName: string): TRttiProperty;
begin
  Result := RttiContext.GetType(aObject.ClassType).GetProperty(aPropertyName);
end;

procedure TPropertyPersist.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPropertyPersist.LoadFromStream(Stream: TStream);
var
  Reader: TReader;
  RttiProperty: TRttiProperty;
begin
  Reader := TReader.Create(Stream, $FFF);
  Stream.Position := 0;
  Reader.ReadListBegin;

  while not Reader.EndOfList do
  begin
    RttiProperty := GetProperty(Self, Reader.ReadString); // Get property from property name read from stream
    RttiProperty.SetValue(Self, TValue.FromVariant(Reader.ReadVariant)); // Get the property value
  end;

  Reader.Free;
end;

procedure TPropertyPersist.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPropertyPersist.SaveToStream(Stream: TStream);
var
  RttiType: TRttiType;
  RttiProperty: TRttiProperty;
  Writer: TWriter;
begin
  RttiType := RttiContext.GetType(Self.ClassType);
  Writer := TWriter.Create(Stream, $FFF);
  try
    Writer.WriteListBegin;

    for RttiProperty in RttiType.GetProperties do
      if RttiProperty.IsWritable then
        if TRttiInstanceType(RttiProperty.Parent).MetaclassType.InheritsFrom(TPropertyPersist) then // Only save components on TPropertyPersist decendans
        begin
          Writer.WriteString(RttiProperty.Name); // Write the property name
          Writer.WriteVariant(RttiProperty.GetValue(Self).AsVariant); // Write the property value
        end;

    Writer.WriteListEnd;

  finally
    Writer.Free;
  end;
end;

end.

编辑如果您有一个较旧版本的Delphi而没有扩展RTTI，那么您需要这个TPropertyPersist的实现

unit PropertyPersistU;

interface

uses
  Classes;

type
  TPropertyPersist = class(TComponent, IStreamPersist)
  public
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
  end;

implementation

uses
  TypInfo, Sysutils;
{ TPropertyPersist }

procedure TPropertyPersist.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPropertyPersist.LoadFromStream(Stream: TStream);
var
  Reader: TReader;
  PropName, PropValue: string;
begin
  Reader := TReader.Create(Stream, $FFF);
  Stream.Position := 0;
  Reader.ReadListBegin;
  while not Reader.EndOfList do
  begin
    PropName := Reader.ReadString;
    PropValue := Reader.ReadString;
    SetPropValue(Self, PropName, PropValue);
  end;
  FreeAndNil(Reader);
end;

procedure TPropertyPersist.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPropertyPersist.SaveToStream(Stream: TStream);
var
  PropName, PropValue: string;
  cnt: Integer;
  lPropInfo: PPropInfo;
  lPropCount: Integer;
  lPropList: PPropList;
  lPropType: PPTypeInfo;
  Writer: TWriter;
begin
  lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
  Writer := TWriter.Create(Stream, $FFF);
  Stream.Size := 0;
  Writer.WriteListBegin;

  for cnt := 0 to lPropCount - 1 do
  begin
    lPropInfo := lPropList^[cnt];
    lPropType := lPropInfo^.PropType;

    if lPropInfo^.SetProc = nil then
      continue;

    if lPropType^.Kind = tkMethod then
      continue;

    PropName := lPropInfo.Name;
    PropValue := GetPropValue(Self, PropName);
    Writer.WriteString(PropName);
    Writer.WriteString(PropValue);
  end;

  Writer.WriteListEnd;
  FreeAndNil(Writer);
end;

end.

那你就叫它吧。

首先，创建一个包含一些属性的小虚拟类：

{$M+}
type
  TSettings = class(TPropertyPersist)
  private
    FPropertyString: string;
    FPropertyDate: TDateTime;
    FPropertyInt: Integer;
  published
    property PropertyInt: Integer read FPropertyInt write FPropertyInt;
    property PropertyString: string read FPropertyString write FPropertyString;
    property PropertyDate: TDateTime read FPropertyDate write FPropertyDate;
  end;

你需要叫它。

procedure TForm1.FormCreate(Sender: TObject);
const
  StringValue = 'Dummy';
begin
  with TSettings.Create(self) do
    try
      PropertyInt := 1;
      PropertyString := StringValue;
      PropertyDate := Now;
      SaveToFile('Settings.dmp');
    finally
      Free;
    end;

  with TSettings.Create(self) do
    try
      LoadFromFile('Settings.dmp');
      Assert(PropertyString = StringValue); //Test that the property is correctly read
    finally
      Free;
    end;    
end;

现在，您可以将类的属性保存并加载到流中。

下一步是创建一个完整的工作示例：

新项目，然后将ClientDataset添加到MainForm和FromCreate事件。

用于ClientDataset的第一个DFM代码：

object ClientDataSet1: TClientDataSet
  Aggregates = <>
  FieldDefs = <>
  IndexDefs = <>
  Params = <>
  StoreDefs = True
  Left = 312
  Top = 176
  object ClientDataSet1FORMDM_NAME: TStringField
    FieldName = 'FORMDM_NAME'
    Size = 31
  end
  object ClientDataSet1OBJ_NAME: TStringField
    FieldName = 'OBJ_NAME'
    Size = 40
  end
  object ClientDataSet1Object: TBlobField
    FieldName = 'Object'
  end
end

然后是完整的代码，单位：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient;

type
  TForm1 = class(TForm)
    ClientDataSet1: TClientDataSet;
    ClientDataSet1FORMDM_NAME: TStringField;
    ClientDataSet1OBJ_NAME: TStringField;
    ClientDataSet1Object: TBlobField;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
  PropertyPersistU;

type
  TSettings = class(TPropertyPersist)
  private
    FPropertyString: string;
    FPropertyDate: TDateTime;
    FPropertyInt: Integer;
  published
    property PropertyInt: Integer read FPropertyInt write FPropertyInt;
    property PropertyString: string read FPropertyString write FPropertyString;
    property PropertyDate: TDateTime read FPropertyDate write FPropertyDate;
  end;

procedure TForm1.FormCreate(Sender: TObject);
const
  StringValue = 'Dummy';
var
  Stream : TMemoryStream;
  Settings : TSettings;
begin
  ClientDataSet1.CreateDataSet;
  Stream := TMemoryStream.Create;

  Settings := TSettings.Create(self);
  try
    Settings.PropertyInt := 1;
    Settings.PropertyString := StringValue;
    Settings.PropertyDate := Now;
    Settings.Name := 'ObjectName';
    Settings.SaveToStream(Stream);
  finally
    Settings.Free;
  end;

  Stream.Position := 0;
  ClientDataSet1.Append;
  ClientDataSet1FORMDM_NAME.AsString := Form1.Name;
  ClientDataSet1OBJ_NAME.AsString := 'ObjectName';
  ClientDataSet1Object.LoadFromStream(Stream);
  ClientDataSet1.Post;

  Caption := 'ClientDataSet1.RecordCount = ' + IntToStr(ClientDataSet1.RecordCount);
  Stream.Free;

  Stream := TMemoryStream.Create;
  Settings := TSettings.Create(self);
  ClientDataSet1.First;
  ClientDataSet1Object.SaveToStream(Stream);

  try
    Settings.LoadFromStream(Stream);
    Assert(Settings.PropertyString = StringValue);
  finally
    Settings.Free;
  end;

  Stream.Free;
end;

end.

就这样。

向TPropertyPersist类添加一些错误处理，但我将留给您。