Pascal 带有TReader/TWriter帮助程序类的ObjectBinaryToText错误

基于，我创建了两个简单的帮助程序，使TWriter.WriteProperties和TReader.ReadProperty成为公共的

它在以二进制对象格式保存持久性内容时工作正常，但在转换为文本时失败

你知道如何制作这种工作文本格式吗？我不想为此重写转换例程

这个简单的控制台程序说明了这个问题：

program tfiler_persistent_hack;
{$MODE DELPHI}

uses
  classes, sysutils;

type

  TReaderEx = class helper for TReader
    procedure ReadPersistent(aValue: TPersistent);
  end;

  TWriterEx = class helper for TWriter
    procedure WritePersistent(aValue: TPersistent);
  end;

  TTest = class(TComponent)
  private
    fList: TStringList;
    procedure ListFromReader(aReader: TReader);
    procedure ListToWriter(aWriter: TWriter);
  protected
    procedure defineProperties(aFiler: TFiler); override;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    property list: TStringList read fList;
  end;

  procedure TReaderEx.ReadPersistent(aValue: TPersistent);
  begin
    ReadListBegin;
    while not EndOfList do ReadProperty(aValue);
    ReadListEnd;
  end;

  procedure TWriterEx.WritePersistent(aValue: TPersistent);
  begin
    WriteListBegin;
    WriteProperties(aValue);
    WriteListEnd;
  end;

  procedure TTest.ListFromReader(aReader: TReader);
  begin
    aReader.ReadPersistent(fList);
  end;

  procedure TTest.ListToWriter(aWriter: TWriter);
  begin
    aWriter.WritePersistent(fList);
  end;

  procedure TTest.defineProperties(aFiler: TFiler);
  begin
    aFiler.defineProperty('the_list_id_liketosave_without_publising', ListFromReader, ListToWriter, true);
  end;

  constructor TTest.create(aOwner: TComponent);
  begin
    inherited;
    fList := TStringList.Create;
  end;

  destructor TTest.destroy;
  begin
    fList.Free;
    inherited;
  end;

var
  test: TTest;
  str1, str2: TMemoryStream;

const
  itm1 = 'aqwzsx';
  itm2 = 'edcrfv';

begin
  test := TTest.create(nil);
  str1 := TMemoryStream.Create;
  str2 := TMemoryStream.Create;
  try

    // bin format passes
    test.list.add(itm1);
    test.list.add(itm2);
    str1.WriteComponent(test);
    str1.SaveToFile('bin.txt');
    str1.Clear;
    test.list.clear;
    str1.LoadFromFile('bin.txt');
    str1.ReadComponent(test);
    assert( test.list.strings[0] = itm1);
    assert( test.list.strings[1] = itm2);
    writeln('bin: zero killed');

    // text format does not
    str1.Clear;
    test.list.clear;
    test.list.add(itm1);
    test.list.add(itm2);
    str1.WriteComponent(test);
    str1.Position := 0;
    try
      ObjectBinaryToText(str1, str2);
    except
      writeln('ouch, it hurts (1)');
      exit;
    end;
    str2.SaveToFile('text.txt');
    str1.Clear;
    str2.Clear;
    test.list.clear;
    str1.LoadFromFile('text.txt');
    try
      ObjectTextToBinary(str1, str2);
    except
      writeln('ouch, it hurts (2)');
      exit;
    end;
    str2.Position := 0;
    str2.ReadComponent(test);
    assert( test.list.strings[0] = itm1);
    assert( test.list.strings[1] = itm2);
    writeln('text: zero killed');

  finally
    sysutils.DeleteFile('bin.txt');
    sysutils.DeleteFile('text.txt');
    test.Free;
    str1.Free;
    str2.Free;
    readln;
  end;

end.

当我运行它时，我得到以下输出：

宾：零死亡 哎哟，疼死我了

---

如果发布列表属性并删除对TFiler.DefineProperty的调用，则一切正常，如预期：

TTest = class(TComponent)
private
  fList: TStringList;
  procedure SetList(Value: TStringList);
public
  constructor Create(aOwner: TComponent); override;
  destructor Destroy; override;
  property list: TStringList read fList;
published
  property the_list_id_liketosave_without_publising: TStringList read fList write SetList;
end;

以下是其DFM二进制数据的外观：

54 50 46 30 05 54 54 65 73 74 00 30 74 68 65 5F : TPF0.TTest.0the_
6C 69 73 74 5F 69 64 5F 6C 69 6B 65 74 6F 73 61 : list_id_liketosa
76 65 5F 77 69 74 68 6F 75 74 5F 70 75 62 6C 69 : ve_without_publi
73 69 6E 67 2E 53 74 72 69 6E 67 73 01 06 06 61 : sing.Strings...a
71 77 7A 73 78 06 06 65 64 63 72 66 76 00 00 00 : qwzsx..edcrfv...

以下是文本输出：

object TTest
  the_list_id_liketosave_without_publising.Strings = (
    'aqwzsx'
    'edcrfv')
end

如您所见，属性名称只有一个字符串：

the_list_id_liketosave_without_publising.Strings

在内部，TStream.ReadComponent读取该字符串并在服务器上拆分它。字符，使用RTTI解析_list_id_like保存_而不发布到实际的TStringList对象，然后在该对象上调用DefineProperties'Strings'以使其流式传输其字符串列表数据，一切正常

ObjectBinaryToText做不了那么多工作。事实上，在查看了RTL源代码之后，发现ObjectBinaryToText至少在Delphi中是这样的，但我相信FreePascal也是这样，它根本不支持通过TComponent.DefineProperties进行自定义流式处理，它从不调用DefineProperties！。这是你问题的根源。ObjectBinaryToText不实现ReadComponent实现的完整流媒体系统，只实现其中的一个子集

但是，在本例中，一切都正常，因为TStringList以简单的格式编写其自定义流数据，ObjectBinaryToText易于处理

当ObjectBinaryToText读取属性名字符串时，它会按原样将其写出，而不以任何方式对其进行解析，然后读取下一个字节并相应地对其进行处理。TStringList使用以下格式：

vaList (TWriter.WriteListBegin())
vaString for each string (TWriter.WriteString())
vaNull (TWriter.WriteListEnd())

ObjectBinaryToText识别这些标记，因此它知道当遇到vaList hex 01时，它需要读取循环中的值，直到读取vaNull hex 00，并且它知道如何读取vaString hex 06值。因此，将字符串数据写入输出文本不会有问题

对于TTest自定义流，它创建的DFM二进制数据略有不同：

54 50 46 30 05 54 54 65 73 74 00 28 74 68 65 5F : TPF0.TTest.(the_
6C 69 73 74 5F 69 64 5F 6C 69 6B 65 74 6F 73 61 : list_id_liketosa
76 65 5F 77 69 74 68 6F 75 74 5F 70 75 62 6C 69 : ve_without_publi
73 69 6E 67 01 07 53 74 72 69 6E 67 73 01 06 06 : sing..Strings...
61 71 77 7A 73 78 06 06 65 64 63 72 66 76 00 00 : aqwzsx..edcrfv..
00 00                                           : ..

如您所见，存在两个单独的属性名称字符串：

the_list_id_liketosave_without_publising

当ObjectBinaryToText在不发布字符串的情况下读取类似于保存的\u列表\u id\u时，它假定它是完整的属性名称，并读取下一个字节以确定要读取的属性数据类型。该字节hex 01被解释为vaList。下一个字节hex 07被解释为vaIdent aka not vaNull，因此它假设正在读取一个非空的子属性列表，而实际上不是。它尝试读取一个vaIdent属性，其中下一个字节十六进制53被解释为缩进的字节长度，而不是缩进的字节长度，然后它尝试读取十进制83中的那么多字节，但失败了

为了使用ObjectBinaryToText使您的TTest自定义流正确工作，您必须通过复制TStrings.DefineProperties实现的相同逻辑来生成兼容的DFM，因为它的流方法是私有和不可访问的，例如：

TTest = class(TComponent)
private
  fList: TStringList;
  procedure ListFromReader(aReader: TReader);
  procedure ListToWriter(aWriter: TWriter);
protected
  procedure DefineProperties(aFiler: TFiler); override;
public
  constructor Create(aOwner: TComponent); override;
  destructor Destroy; override;
  property list: TStringList read fList;
end;

procedure TTest.ListFromReader(aReader: TReader);
begin
  aReader.ReadListBegin;
  fList.BeginUpdate;
  try
    fList.Clear;
    while not aReader.EndOfList do fList.Add(aReader.ReadString);
  finally
    fList.EndUpdate;
  end;
  aReader.ReadListEnd;
end;

procedure TTest.ListToWriter(aWriter: TWriter);
var
  I: Integer;
begin
  aWriter.WriteListBegin;
  for I := 0 to fList.Count - 1 do aWriter.WriteString(fList[I]);
  aWriter.WriteListEnd;
end;

procedure TTest.DefineProperties(aFiler: TFiler);
begin
  inherited;
  aFiler.DefineProperty('the_list_id_liketosave_without_publising', ListFromReader, ListToWriter, fList.Count > 0);
end;

constructor TTest.Create(aOwner: TComponent);
begin
  inherited;
  fList := TStringList.Create;
end;

destructor TTest.Destroy;
begin
  fList.Free;
  inherited;
end;

这将生成此DFM二进制数据：

54 50 46 30 05 54 54 65 73 74 00 28 74 68 65 5F : TPF0.TTest.(the_
6C 69 73 74 5F 69 64 5F 6C 69 6B 65 74 6F 73 61 : list_id_liketosa
76 65 5F 77 69 74 68 6F 75 74 5F 70 75 62 6C 69 : ve_without_publi
73 69 6E 67 01 06 06 61 71 77 7A 73 78 06 06 65 : sing...aqwzsx..e
64 63 72 66 76 00 00 00                         : dcrfv...

将生成此输出文本：

object TTest
  the_list_id_liketosave_without_publising = (
    'aqwzsx'
    'edcrfv')
end

这就是ObjectBinaryToText的工作方式，无法绕过它。它不是像您尝试实现的那样为通用定制流媒体而设计的。它非常擅长于它能处理和不能处理的事情。请记住，它主要是为IDE编辑器设计的，用于向用户显示DFM，因此它依赖于使用简单流格式发布的组件。您试图实现的内容超出了它的解析能力

---

两个字节有多大的区别啊？

失败并不是一个有意义的问题描述。它以什么方式失败？失败是什么意思？您在包含代码方面做得很好，但未能提供问题描述或提出问题。您正在使用异常处理，但没有输出错误消息。从这开始，这会给你一些关于哪里出了问题的线索。例如，当我在Delpih中运行代码时，第一个错误是EReadError流读取错误异常。我不知道FreePascal，但在Delphi中，您可以逐步查看RTL源代码，并找出流读取不正确的确切原因。唉，我在Lazarus+FPC中编程，添加了标记“Delphi”只是为了扩大受众。事实上，我知道用Delphi我可以检查“使用调试dcu”并很容易地找到问题，但用Laz就不那么简单了。谢谢你对我问题的专业知识。我想对你的答案投赞成票，但我不能再投了，因为有人有好主意对我的问题投反对票……对他来说：和平人，问题没有那么严重地暴露出来。

object TTest
  the_list_id_liketosave_without_publising = (
    'aqwzsx'
    'edcrfv')
end