Delphi：将TComponent保存到Clientdataset blob字段

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

火鸟桌是

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

正在写入数据库

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);

（全局设置是TSAVComponent。）

正在从数据库读取

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

问题：始终在Stream.ReadComponent（self）行中出现“Stream read error”。请问如何解决这个问题

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

编辑： 整个解决方案使用IBX组件；

---

使用DBExpress/Clientdataset组件，从blob字段读取流总是会导致

“流读取错误”。

正如您需要实现

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.

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

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.

那你就得打电话了

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;

首先创建一个带有一些属性的小虚拟CLASA：

{$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

就这样

---

在

TPropertyPersist

类中添加一些错误处理，但这将留给您

Firebird表DDL的定义应如下所示（注意子类型0，而不是最初定义的1）：

多好的。。。。我一直忽视它

---

参考资料：

这不是您真正的代码。对

ReadFromBlobField1（）

的调用与您显示的声明不匹配。仅供参考，请在

TSaveComponent

中实现

IStreamPersist

，您只需将实例分配给blob字段即可。无需专门的

SaveToBlobField

或

ReadFromBlobField

即可通过

dbMain.ClientDataSet2.FieldByName（'OBJECT'）.Assign进行保存（settingsInstance）和加载方式
settingsInstance.Assign（dbMain.ClientDataSet2.FieldByName（'OBJECT'）因为您实现了
IStreamPersist
；o） @Jens，由于我还不能测试你的代码，请问这是否与我正在使用的delphi7兼容？（很抱歉之前没有提到）不会，因为Delphi7没有扩展RTTI。您还必须检查Delphi 7是否知道
IStreamPersist
，以及
TBlobField
是否在
Assign
/
AssignTo
方法中处理此接口。@JeffP not t与Delphi 7不兼容，但我将为您提供一个更新。悬挂on@JensBorrisholt我认为整个代码工作正常，可以从文件/流中保存/加载。但在尝试从流加载时，我仍然会遇到“流读取错误”，但在处理从/到文件的加载/保存时则不会。当发布的属性不包含数据（空）时，会出现问题。当不是Reader.EndOfList do时，错误在此处激发，有时在此处激发：
PropValue:=Reader.ReadString
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.

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