1

我有一个像下面这样的 TComponent 类派生，试图保存到客户端数据集 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)
);

写入数据库...

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

（全局设置为 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.'

4

2 回答 2

1

正如评论中所说，您需要实施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.

然后你需要调用它。

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

{$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，但我会留给你。

于 2015-10-20T05:17:18.097 回答
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/

于 2015-10-26T07:03:15.083 回答