堆栈内存溢出
  繁体   English   中英

如何在Arrays的自定义类对象中使用DefineProperties - Delphi

[英]How to use DefineProperties in a custom Class Object for Arrays - Delphi

 原文  2013-12-18 16:09:05  1   1    arrays/ delphi/ class/ serialization/ components

问题描述

我正在尝试创建自己的类对象并使用它来存储我的应用程序的各种数据类型，这一切都可以正常使用已发布的属性，我可以将这些流传输到磁盘并返回没有问题。 但我需要流式传输一些整数和字符串数据类型的数组。

据我所知，Arrays，以及其他数据类型无法发布属性，因为Delphi不知道如何流式传输它们，我被认为需要使用DefineProperties来实现这一点，我已经创建了一个测试Array of String as一个公共属性，我可以读取和写入它很好，但我需要将其流式传输到磁盘，以便我可以保存它以备将来使用。

我能找到的唯一触及这个主题的是：

自定义类的数组作为属性

我试图复制这段代码并操纵它来存档我需要的东西，但我无法保存它，我似乎遗漏了一些明显的东西，我正在使用的测试代码如下，我的代码没有错误，已发布的属性流到磁盘确定但我的私有阵列没有。 任何帮助将不胜感激。

谢谢。 

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建议的代码修改从下面重写： 

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.

1 个解决方案

解决方案1
 2 已采纳  2013-12-18 16:30:26

你实际上如何尝试读写它？ 我认为你在尝试制作复杂的不兼容的东西，而不是使用标准方法。

为什么不使用标准的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自定义为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。 因为TComponent已经从TPersistent派生，所以你不需要{$ M +}

PPS。 想对这个问题的更新发表评论，但手机拒绝做（太长了？）所以把它放在这里。

1：由于我们不再使用RTTI，因此不再需要使用Typinfo单元。 2： if N = Length(FFullArray) then缺少ELSE路径。 好的，现在我们了解到DFM已损坏或不兼容，那么呢？ 我想我们最好提出一些错误。 或者尝试删除N个字符串列表，以便可以读取下一个属性。 甚至删除任何类型/数量的元素列表，直到列表结束。 未来的兼容性永远不会得到保证，但至少可以做一些尝试，甚至只是为了明确地停止错误。 跳过阅读并默默地将读者留在财产中间，所以下一个属性会变得疯狂，我认为不是这样做的。

通常大卫在设置器和吸气器中忽略不正确的指数是正确的。 除非你故意通过设置或获取“免费”“未绑定”索引（这两者都没有代码）来从稀疏数组中的默认模板创建一些不寻常的隐式项创建模式，否则至少在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中称为第1行。 然后你可以正确使用正确的索引值。

暂无
暂无

声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 如何在Delphi中使用变量数组 如何合并要排序的Java中的自定义类数组 如何将包含数组的对象添加到类 Delphi中的数组（对象帕斯卡）使用变量？ 自定义对象中的两个数组 自定义对象数组和For循环 如何在具有数组的对象上使用usort 如何使用两个数组在javascript中形成一个对象？ Delphi-&gt; Delphi棱镜，如何使用记录数组？ 如何使用数组将实例化对象用作方法的参数
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM