ClientDataSet

ClientDataSet

关注
发信
关注(28)粉丝(399)

delphi - Delphi:将TComponent保存到Clientdataset Blob字段

我有一个如下所示的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);


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

最佳答案

如评论中所述，您需要实现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.


然后，您需要调用它。

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

{$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类中添加一些错误处理，但是我留给您。

关于delphi - Delphi:将TComponent保存到Clientdataset Blob字段，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/33224848/

10-10 06:36
Powered by LMLPHP ©2024 ClientDataSet 0.032855