Question

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

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

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

Array of a custom class as a property

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

感谢。

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.

Answer 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自定义为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个字符串列表，以便可以读取下一个属性。甚至删除任何类型/数量的元素列表，直到列表结束。未来的兼容性永远不会得到保证，但至少可以做一些尝试，甚至只是为了明确地停止错误。跳过阅读并默默地将读者留在财产中间，所以下一个属性会变得疯狂，我认为不是这样做的。

一般来说大卫对于忽略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中作为第1行调用。然后你可以正确使用正确的索引值。

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

1 个答案: