1

以下のような 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)
);

データベースに書き込み中...

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 は 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 で公開されたフィールドを確認しましたが、それが正しい形式であるかどうかはわかりません。(必要に応じて 16 進表現を表示できます)

編集: ソリューション全体が IBX コンポーネントで動作します。DBExpress/Clientdataset コンポーネントでは、blob フィールドからストリームを読み取ると、常に次の結果になります。'Stream read error.'

4

2 に答える 2

1

Firebird テーブルの DDL は次のように定義されている必要があります (最初に定義された 1 ではなく、sub_type 0 に注意してください)。

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 に答える
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.

EDIT 拡張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 に答える