Delphi: Сохранить ТСотропепЬ в ClientDataSet поля блоба

Question

У меня есть класс, производный TComponent, как показано ниже, при попытке сохранить поле ClientDataSet блобо: (Скопировано из Интернета, из-за кредиты)

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 таблица .. .

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

(Globalsetting является Цав eComponent)

Чтение из БД ...

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

ПРОБЛЕМЫ. "Поток ошибки чтения" в Stream.ReadComponent (сам) линия, всегда. Как это решить, пожалуйста?

Я могу подтвердить сохранение компонентов. Я проверил таблицу и посмотрел опубликованные поля в GlobalSetting, я просто не уверен, что это правильный формат. (Я могу показать представление шестигранной при необходимости)

EDIT: Весь раствор работает с компонентами IBX; С компонентами DBExpress/ClientDataSet, чтение потока из поля BLOB всегда приводит к 'Stream read error.'

Answer 1

Жар таблица 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. 

EDIT Если у вас есть более старая версия 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. 

Тогда вам нужно вызвать его.

Сначала создайте небольшой манекен 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 события.

Первый DFM код 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 

Тогда полный код блока:

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, но я оставлю вас.