带有TReader / TWriter助手类的ObjectBinaryToText错误

时间:2014-08-22 00:50:10

标签: pascal fpc

根据this example,我创建了两个简单的助手,使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.

当我运行它时,我得到以下输出:

  

bin:零死亡   哎哟,好痛(1)

1 个答案:

答案 0 :(得分:4)

如果您创建了列表属性published并删除了对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将the_list_id_liketosave_without_publising解析为实际的TStringList对象,然后调用{{1}在该对象上让它传递其字符串列表数据,一切都很好。

DefineProperties('Strings')没做那么多工作。事实上,在查看RTL源代码后,结果是ObjectBinaryToText()(至少在Delphi中,但我确定FreePascal是一样的)不支持支持自定义流式传输完全ObjectBinaryToText()(它永远不会调用TComponent.DefineProperties())!这是你问题的根源。 DefineProperties()没有实现ObjectBinaryToText()实现的完整流式传输系统,只实现了它的一部分。

但是,在这种情况下,一切正常,因为ReadComponent()以简单的格式编写自定义流数据,TStringList可以轻松处理。

ObjectBinaryToText()读取属性名称字符串时,它会按原样将其写出,而不以任何方式解析它,然后读取下一个字节并相应地处理它。 ObjectBinaryToText()使用以下格式:

TStringList

vaList (TWriter.WriteListBegin()) vaString for each string (TWriter.WriteString()) vaNull (TWriter.WriteListEnd()) 会识别这些标记,因此它知道当遇到ObjectBinaryToText()(十六进制vaList)时,它需要在循环中读取值,直到它读取01 (十六进制vaNull),它知道如何阅读00(十六进制vaString)值。因此,将06数据写出到输出文本没有问题。

对于Strings自定义流式传输,它创建的DFM二进制数据略有不同:

TTest

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

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

Strings 读取ObjectBinaryToText()字符串时,它会假定它是完整的属性名称并读取下一个字节以确定要读取的属性的数据类型。该字节(十六进制the_list_id_liketosave_without_publising)被解释为01。下一个字节(十六进制vaList)被解释为07(又名vaIdent),因此它假定正在读取非空的子属性列表(实际上并非如此)。它试图读取not vaNull“属性”,其中下一个字节(十六进制vaIdent)被解释为缩进的字节长度(它不是),然后它尝试读取那么多字节(十进制) 83)并失败。

为了使53自定义流式传输与TTest一起正常工作,您必须通过复制ObjectBinaryToText()实现的相同逻辑(作为其流式传输方法)来生成兼容的DFM是TStrings.DefineProperties()且无法访问),例如:

private

生成此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;

生成此输出文本:

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 的工作方式,没有绕过它。它不是为您尝试实现的通用自定义流而设计的。它非常专业,可以(也可以)处理。请记住,它主要是为IDE编辑器设计的,用于向用户显示DFM,因此它依赖于使用简单流式格式的已发布组件。您尝试实现的内容超出了其解析能力。

几个字节有什么区别,是吗?