Delphi: Save TComponent to Clientdataset blob field

Question

I have a TComponent class derivative like below, trying to save to a clientdataset blob field: (Copied from internet, due credits)

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;

Firebird table is ...

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

Writing to 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 is TSaveComponent.)

Reading from db ...

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

PROBLEM: "Stream read error" in Stream.ReadComponent(self) line, always. How to solve this, please?

I can confirm saving the component works. I inspected the table and see the published fields in GlobalSetting, I'm just not sure if it is the correct format. (I can show the hex representation if needed)

EDIT: The whole solution works with IBX components; With DBExpress/Clientdataset components, reading the stream from the blob field always results in 'Stream read error.'

This is not your real code. The call to `ReadFromBlobField1()` does not match the declaration you have shown. — Remy Lebeau, Oct 19 '15 at 23:26
FYI Implement `IStreamPersist` in your `TSaveComponent` and you can simply assign the instance to the blob field. There is no need to have a specialized `SaveToBlobField` or `ReadFromBlobField` — Sir Rufo, Oct 19 '15 at 23:35

Jens Borrisholt · Answer 1 · 2015-10-20T16:18:49.907

As said in the comments you need to implement IStreamPersist. In order fordoing that you can use RTTI, to store and restore your properties. I've created an example for you:

First you need a class that can persist all your properties, and it's values.

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.

EDIT If you have an older version of Delphi without extended RTTI then you need this implementation of 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.

Then you need to call it.

First create a small dummy clasas with some properties on it:

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

The you need to call it.

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;

Now you can save and load a the properties of a class to a stream.

Next step is to create a complete working example:

New project and then add a ClientDataset to the MainForm and a FromCreate event.

First DFM code for the ClientDataset:

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

Then the complete code the unit:

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.

That's it.

Add some error handling to the TPropertyPersist class, but that I'll leave to you.

Yon can save by `dbMain.ClientDataSet2.FieldByName('OBJECT').Assign( settingsInstance );` and load by `settingsInstance.Assign( dbMain.ClientDataSet2.FieldByName('OBJECT') );` because you implement `IStreamPersist` ;o) — Sir Rufo, Oct 20 '15 at 06:24
@Jens, as I cannot yet test your code, may I ask, is this compatible with Delphi 7 which I am using? (Sorry for not mentioning earlier) — JeffP, Oct 20 '15 at 07:24
No it will not, because Delphi 7 has no extended RTTI. Also you have to check if Delphi 7 is aware of `IStreamPersist` and if `TBlobField` handle this interface in `Assign`/`AssignTo` methods. — Sir Rufo, Oct 20 '15 at 07:40
@JeffP not t's not compatible with Delphi 7, but I'll make you an update that is. Hang on — Jens Borrisholt, Oct 20 '15 at 07:45
@JeffP there you go. Tested with Delphi 6. (I have no Delphi 7) — Jens Borrisholt, Oct 20 '15 at 08:04
Since `dbMain.ClientDataSet2.FieldByName('OBJECT').Assign( settingsInstance );` as suggested by @SirRufo doesn't work with D7 either, I have to figure out how to actually save this Object — JeffP, Oct 20 '15 at 12:40
@JeffP there you go. A complete working example. This will show you how to store a stream in a ClientDataset, and load it again. So now it's closing time! — Jens Borrisholt, Oct 20 '15 at 16:20
@JensBorrisholt I think the whole code works as intended, can save/load from file/stream. But I still get the 'Stream read error' specifically when trying to load from stream, but not when dealing with load/save from/to file. The problem appears when a published property contains no data (empty). Error fires here `while not Reader.EndOfList do`, sometimes here: `PropValue := Reader.ReadString;` — JeffP, Oct 20 '15 at 19:00
Can you make me an example. I'm not sure what the problemi is — Jens Borrisholt, Oct 20 '15 at 19:12
Sorry for late reply, been working on it. To reproduce the error, try using a real database. Then connect with dbexpress componnents sqlconnection, sqldataset, datasetprovider, and clientdataset. When you get to the point where you stream from tblobfield to stream, 'Stream read error' occurs. This seems to happen when at least one published prop is saved without a value. This is the offending code `ClientDataSet1Object.SaveToStream(Stream);` — JeffP, Oct 22 '15 at 20:53
No, not null, just empty string. In the example code, try adding another published property, say 'AnotherString'. Then run the program without assigning anything to AnotherString. If your saving to a real FB database you'd run into the problem when you retrieve the blob field. May I refere you back 4 comments above. — JeffP, Oct 22 '15 at 21:29
@JeffP basically you can just skip empty strings. But this thing here is part of the task "error handling" I'll leave that to you. :D — Jens Borrisholt, Oct 23 '15 at 08:11
You could use default values and just skip them http://stackoverflow.com/questions/30352756/delphi-how-to-get-default-value-for-property-using-rtti — Jens Borrisholt, Oct 23 '15 at 08:12
My final observation is that, the stream saved to clientdataset does not match the data in the clientdataset1OBJECT.AsString, for whatever reason. Naturally, reading from this TBlobField will yield mismatched data compared to the TSetting Object. 'Playing' yields correct results, but once a live db is involved, nothing cooperates. A few more tries, and I have to abandon and move on. :( — JeffP, Oct 24 '15 at 09:00
@JeffP with little effort you could fix the few bugs that are left. If you want ot do it diffrent fine for me. i can keep on supporting this question — Jens Borrisholt, Oct 24 '15 at 12:22
@JensBorrisholt, thank you for efforts. Forget what I said about empty strings values, it's not the problem. I found out it is possible to save via stream to a clientdataset blob field, but the reverse is problematic, always `'Stream read error.'` My workaround is to use IBX components which works quite well, but I'm not happy about it. It's only a bandaid. — JeffP, Oct 25 '15 at 02:34

score 1 · Accepted Answer · answered Oct 26 '15 at 07:03

The Firebird table DDL should have been defined as follows (note sub_type 0, not 1 as originally defined):

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

What a .... been ignoring it all the while.

Reference: http://www.firebirdfaq.org/faq165/

Delphi: Save TComponent to Clientdataset blob field

2 Answers2