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