I've created two simple helpers to make TWriter.WriteProperties() and TReader.ReadProperty() public, based on this example.
It works fine when saving the persistent things in binary object format but fails when converting to text.
Any idea about how to make this working (text format)? I don't want to rewrite the conversion routines just for this.
The problem is illustrated in this simple console program:
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.
When I run it, I get the following output:
bin: zero killed
ouch, it hurts (1)
If you make your list property published and remove the call to TFiler.DefineProperty(), everything works correctly, as expected:
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;
Here is what its DFM binary data looks like:
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...
And here is the text output:
object TTest
the_list_id_liketosave_without_publising.Strings = (
'aqwzsx'
'edcrfv')
end
As you can see, there is a single string for the property name:
the_list_id_liketosave_without_publising.Strings
Internally, TStream.ReadComponent() reads that string and splits it on the . character, using RTTI to resolve the_list_id_liketosave_without_publising to the actual TStringList object, and then calling DefineProperties('Strings') on that object to let it stream its string list data, and all is fine.
ObjectBinaryToText() doesn't do that much work. In fact, after looking at the RTL source code, it turns out that ObjectBinaryToText() (at least in Delphi, but I'm sure FreePascal is the same way) DOES NOT support custom streaming via TComponent.DefineProperties() at all (it never calls DefineProperties())!. That is the root of your problem. ObjectBinaryToText() does not implement the full streaming system that ReadComponent() implements, only a subset of it.
However, in this case, everything is OK because TStringList writes its custom streaming data in a simple format that is easy for ObjectBinaryToText() to process.
When ObjectBinaryToText() reads the property name string, it writes it out as-is without parsing it in any way, then reads the next byte and processes it accordingly. TStringList uses this format:
vaList (TWriter.WriteListBegin())
vaString for each string (TWriter.WriteString())
vaNull (TWriter.WriteListEnd())
ObjectBinaryToText() recognizes those markers, so it knows that when it encounters vaList (hex 01) that it needs to read values in a loop until it reads a vaNull (hex 00), and it knows how to read a vaString (hex 06) value. So it has no trouble writing out the Strings data to the output text.
In the case of your TTest custom streaming, the DFM binary data it creates is a little bit different:
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 : ..
As you can see, there are two separate property name strings present:
the_list_id_liketosave_without_publising
Strings
When ObjectBinaryToText() reads the the_list_id_liketosave_without_publising string, it assumes it is the full property name and reads the next byte to determine the property's data type for reading. That byte (hex 01) is interpreted as vaList. The next byte (hex 07) is interpreted as vaIdent (aka not vaNull), so it assumes a non-empty list of subproperties is being read (which it really isn't). It tries to read a vaIdent "property", where the next byte (hex 53) is interpreted as the indent's byte length (which is it not), then it tries to read that many bytes (decimal 83) and fails.
In order to make your TTest custom streaming work correctly with ObjectBinaryToText(), you will have to produce a compatible DFM, by duplicating the same logic that TStrings.DefineProperties() implements (as its streaming methods are private and inaccessible), eg:
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;
Which produces this DFM binary data:
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...
Which produces this output text:
object TTest
the_list_id_liketosave_without_publising = (
'aqwzsx'
'edcrfv')
end
That is simply the way ObjectBinaryToText() works, there is no getting around it. It is not designed for general purpose custom streaming like you are trying to implement. It is very specialized in what it can (and cannot) handle. Remember, it is designed primarily for the IDE editor to display DFMs to users, so it relies on published components using simple streaming formats. What you tried to implement is outside of its ability to parse.
What a difference a couple of bytes make, huh?