如何在数组的自定义类对象中使用 DefineProperties - Delphi
Posted
技术标签:
【中文标题】如何在数组的自定义类对象中使用 DefineProperties - Delphi【英文标题】：How to use DefineProperties in a custom Class Object for Arrays - Delphi 【发布时间】：2014-01-06 21:59:40 【问题描述】：我正在尝试创建自己的类对象并使用它来为我的应用程序存储各种数据类型，这在使用 Published Properties 时一切正常，我可以毫无问题地将这些流式传输到磁盘并返回。但我还需要流式传输一些整数和字符串数据类型的数组。
我知道数组和其他数据类型不能发布属性，因为 Delphi 不知道如何流式传输它们，我被引导相信您需要使用 DefineProperties 来完成此操作，我创建了一个测试数组作为公共属性的字符串，我可以很好地读取和写入它，但是我需要将它流式传输到磁盘，以便我可以保存它以备将来使用。
我能找到的关于这个主题的唯一内容是：
Array of a custom class as a property
我试图复制此代码并对其进行操作以存档我需要的内容，但我无法保存它，我似乎遗漏了一些明显的东西，我正在使用的测试代码如下，我没有收到任何错误这段代码，将属性流发布到磁盘可以，但我的私有阵列没有。任何帮助将不胜感激。
谢谢。
unit UnitDataSet;
//------------------------------------------------------------------------------
interface
uses System.Classes;
$M+
//------------------------------------------------------------------------------
type
TDataStrings = Array [1..50] of String;
TDataSet = class(TComponent)
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader: TReader);
procedure WriteArray(Writer: TWriter);
private
FArrayToSave : TDataStrings;
FPStr : String;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
property Items[I: Integer]: String read GetItem write SetItem;
published
property StringItem : String read FPStr write FPStr;
end;
//------------------------------------------------------------------------------
var
DataSet: TDataSet;
implementation
uses TypInfo, Sysutils;
TDataSet
//------------------------------------------------------------------------------
procedure TDataSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
destructor TDataSet.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
function TDataSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > 0) and (I < Length(FArrayToSave)) then
Result := FArrayToSave[I];
end;
//------------------------------------------------------------------------------
procedure TDataSet.SetItem(I: Integer; Value: string);
begin
if (I > 0) and (I < Length(FArrayToSave)) then
FArrayToSave[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.LoadFromStream(const 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 TDataSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TDataSet.SaveToStream(const 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 lPropType^.Kind = tkMethod then Continue;
PropName := lPropInfo.Name;
PropValue := GetPropValue(Self, lPropInfo);
Writer.WriteString(PropName);
Writer.WriteString(PropValue);
end;
Writer.WriteListEnd;
FreeAndNil(Writer);
end;
//------------------------------------------------------------------------------
constructor TDataSet.Create(aOwner: TComponent);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TDataSet.ReadArray(Reader: TReader);
var
N: Integer;
begin
N := 0;
Reader.ReadListBegin;
while not Reader.EndOfList do begin
Reader.ReadListBegin;
FArrayToSave[N] := Reader.ReadString;
Reader.ReadListEnd;
Inc(N);
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := 1 to High(FArrayToSave) do begin
Writer.WriteListBegin;
Writer.WriteString(FArrayToSave[I]);
Writer.WriteListEnd;
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
DataSet := TDataSet.Create(Nil);
finalization
FreeAndNil(DataSet);
end.
//------------------------------------------------------------------------------
这是我用 Arioch 建议的代码修改从下面重写的 Class 代码：
unit UnitCharSett;
interface
//------------------------------------------------------------------------------
uses System.Classes;
//------------------------------------------------------------------------------
type
TCustomDatSetA = Array [0..99] of String;
TCustomCharSet = class(TComponent)
public
procedure LoadFromStream(const Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SaveToStream(const Stream: TStream);
procedure SaveToFile(const FileName: string);
end;
TZCharSet = class(TCustomCharSet)
private
FFullArray : TCustomDatSetA;
function GetItem(I: Integer): String;
procedure SetItem(I: Integer; Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadArray(Reader:TReader);
procedure WriteArray(Writer:TWriter);
public
property Items[Index: Integer]: string read GetItem write SetItem;
published
end;
//------------------------------------------------------------------------------
implementation
uses
System.TypInfo, System.SysUtils;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(Self);
end;
//------------------------------------------------------------------------------
TZCharSett
//------------------------------------------------------------------------------
procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;
//------------------------------------------------------------------------------
function TZCharSet.GetItem(I: Integer): string;
begin
Result := '';
if (I > -1) and (I < Length(FFullArray)) then
Result := FFullArray[I];
end;
//------------------------------------------------------------------------------
procedure TZCharSet.ReadArray(Reader: TReader);
var
N: Integer;
S: String;
begin
for N := Low(FFullArray) to High(FFullArray) do begin
FFullArray[N] := '';
end;
Reader.ReadListBegin;
N := Reader.ReadInteger;
if N = Length(FFullArray) then
begin
N := Low(FFullArray);
while not Reader.EndOfList do
begin
S := Reader.ReadString;
if N <= High(FFullArray) then
FFullArray[N] := S;
Inc(N);
end;
end;
Reader.ReadListEnd;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
if (I > -1) and (I < Length(FFullArray)) then
FFullArray[I] := Value;
end;
//------------------------------------------------------------------------------
procedure TZCharSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(Length(FFullArray));
for I := Low(FFullArray) to High(FFullArray) do begin
Writer.WriteString(FFullArray[I]);
end;
Writer.WriteListEnd;
end;
//------------------------------------------------------------------------------
initialization
RegisterClasses([TZCharSet]);
//------------------------------------------------------------------------------
end.
【问题讨论】：
当然，您的实际问题的简单答案是创建一个TFileStream 并致电WriteComponent。
ReadArray 中的索引减一。它从零开始。顺便说一句，在 Delphi 中使用基于 1 的数组会引起混淆。首选基于零的数组。事实上，更喜欢动态数组。 FArrayToSave 似乎命名错误。在ReadArray 中使用它时看起来很奇怪。 GetItem 和 SetItem 中的 if 语句看起来很糟糕。他们鼓励代码的使用者传递无效的索引，并且永远不会发现他们弄错了。我认为您需要先修复基础知识，然后再继续。
...在项目选项中设置了使用调试 DCU
"for I := 1 to High(FArrayToSave)" - 很奇怪，“1 to 50”或“Low to High”。并且读取数组应该进行完整性检查以不写入元素 51、52 等（如果损坏的 DFM 或新版本的组件会创建具有更长数组的 dfm）
类 TDataSet 的名称不会与 STOCK TDataSet 冲突吗？
【参考方案1】：
您实际上是如何尝试读写它的？我认为您正在尝试制作复杂的不兼容的东西，而不是使用标准方法。
为什么不使用标准的 VCL 流程序？
procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
Stream.WriteComponent(self);
end;
procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
Stream.ReadComponent(self);
end;
但是，如果不使用 TFiler 和标准 VCL 流媒体，而是使用 RTTI (GetPropList) 编写自定义代码 - 那么它不会将这些虚拟属性 APi custom 调用到TFiler 并且只会显示真实属性。
所以我的建议是使用如上所示的标准方法并简化和强化代码。
由于RegisterClass 使用类名，您最好选择另一个名称，不要与来自库存数据库单元的真实TDataSet 冲突。
修复名称并注册类，以便 VCL 流媒体可以通过名称找到它！例如：
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
S := Reader.ReadString; // even if we would not save it - we should remove it from the input
if N <= High(FArrayToSave) then
FArrayToSave[N] := S;
Inc(N);
end;
Reader.ReadListEnd;
end;
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
Writer.WriteString(FArrayToSave[I]);
end;
Writer.WriteListEnd;
end;
initialization
DataSet := TMyDataSet.Create(Nil);
RegisterClasses([TMyDataSet]);
finalization
DataSet.Free;
end.
此外，我认为您最好 - 为了将来的可扩展性 - 将数组长度保存在 DFM 中。
procedure TMyDataSet.WriteArray(Writer: TWriter);
var
I: Integer;
begin
Writer.WriteInteger(Length(FArrayToSave));
Writer.WriteListBegin;
for I := Low(FArrayToSave) to High(FArrayToSave) do begin
....
procedure TMyDataSet.ReadArray(Reader: TReader);
var
N: Integer; S: String;
begin
for N := Low(FArrayToSave) to High(FArrayToSave) do begin
FArrayToSave := ''; // in case DFM would have less elements than 50
N := Reader.ReadInteger;
if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error
N := Low(FArrayToSave);
Reader.ReadListBegin;
while not Reader.EndOfList do begin
PS。你不需要 $M+ 因为 TComponent 已经派生自 TPersistent
PPS。想对问题中的更新发表评论，但手机拒绝这样做（太长了？）所以把它放在这里。
1：由于我们不再使用 RTTI，因此不再需要使用 Typinfo 单元。 2：if N = Length(FFullArray) then 缺少 ELSE 路径。好的，现在我们了解到 DFM 已损坏或不兼容，然后呢？我认为我们最好提出一些错误。或者尝试删除 N 个字符串的列表，以便可以读取下一个属性。甚至删除任何类型/数量的元素列表，直到列表结束。永远不会保证未来兼容，但至少可以进行一些尝试，即使只是显式地因错误而停止。跳过阅读并默默地将阅读器留在属性中间，所以下一个属性会变得疯狂，我认为不是这样做的方法。
通常，David 关于忽略 setter 和 getter 中不正确的索引是正确的。除非您有意通过设置或获取“免费”“未绑定”索引（两者都没有代码）来从稀疏数组中的默认模板创建一些不寻常的隐式项目模式，否则至少在 Delphi 中更好的方法是“失败”早期的”。这就是您班级的用户默认情况下所期望的。有点像
Procedure class.CheckArrayIdx(const i: integer);
Var mx, mn : integer;
Begin
Mn := low(myarray) ; Mx := high(myarray);
If (i <= mx) and (I >= mn) then exit;
Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d', [
Self.ClassName, mn, I, mx]) ;
End;
这个过程在setter和getter中都可以作为第一行调用。然后你可以使用肯定正确的索引值。
【讨论】：
无论多么奇怪，读者似乎都有相同的逻辑（尽管读入了错误的索引）。 中肯的建议，但为什么这会改变行为？除了阅读器上的虚假索引。 @SertacAkyuz 你确定EndOfList 在读取内部列表后会如何表现？
@Arioch - 不，实际上我不是。
@DavidHeffernan 实际上有三个建议（+ 名称和注册）。并且非典型的无意义的列表使用可能会导致 VCL 进入意想不到的糟糕测试的代码路径。以上是关于如何在数组的自定义类对象中使用 DefineProperties - Delphi的主要内容，如果未能解决你的问题，请参考以下文章
如何将从webapi返回的自定义对象数组的HttpResponse响应分配给打字稿角度中相同数组类型的对象？