I'm creating a package in which a custom image list reads and writes its content inside a DFM file.
The code I wrote works globally well in all compilers between XE7 and 10.3 Rio. However I have a strange issue in XE2. With this particular compiler, I sometimes receives an empty stream content while the DFM is read, and sometimes a corrupted content.
My custom image list is built above a standard TImageList. I register my read callback this way:
procedure TMyImageList.DefineProperties(pFiler: TFiler);
function DoWritePictures: Boolean;
begin
if (Assigned(pFiler.Ancestor)) then
Result := not (pFiler.Ancestor is TMyImageList)
else
Result := Count > 0;
end;
begin
inherited DefineProperties(pFiler);
// register the properties that will load and save the pictures binary data in DFM files
pFiler.DefineBinaryProperty('Pictures', ReadPictures, WritePictures, DoWritePictures);
end;
Here is the ReadPictures function:
procedure TMyImageList.ReadPictures(pStream: TStream);
begin
LoadPictureListFromStream(m_pPictures, pStream);
end;
Here is the LoadPictureListFromStream function:
procedure TMyImageList.LoadPictureListFromStream(pList: IWPictureList; pStream: TStream);
var
{$if CompilerVersion <= 23}
pImgNameBytes: Pointer;
pData: Pointer;
{$else}
imgNameBytes: TBytes;
{$ifend}
count, i: Integer;
color: Cardinal;
imgClassName: string;
pMemStr: TMemoryStream;
size: Int64;
pItem: IWPictureItem;
pGraphicClass: TGraphicClass;
pGraphic: TGraphic;
begin
// read the list count
pStream.ReadBuffer(count, SizeOf(count));
// is list empty?
if (count <= 0) then
Exit;
pMemStr := TMemoryStream.Create;
// enable the code below to log the received stream content
{$ifdef _DEBUG}
size := pStream.Position;
pStream.Position := 0;
pMemStr.CopyFrom(pStream, pStream.Size);
pMemStr.Position := 0;
pMemStr.SaveToFile('__DfmStreamContent.bin');
pMemStr.Clear;
pStream.Position := size;
{$endif}
try
for i := 0 to count - 1 do
begin
pItem := IWPictureItem.Create;
try
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image type from stream
if (size > 0) then
begin
{$if CompilerVersion <= 23}
pImgNameBytes := nil;
try
GetMem(pImgNameBytes, size + 1);
pStream.ReadBuffer(pImgNameBytes^, size);
pData := Pointer(NativeUInt(pImgNameBytes) + NativeUInt(size));
(PByte(pData))^ := 0;
imgClassName := UTF8ToString(pImgNameBytes);
finally
if (Assigned(pImgNameBytes)) then
FreeMem(pImgNameBytes);
end;
{$else}
SetLength(imgNameBytes, size);
pStream.Read(imgNameBytes, size);
imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
{$ifend}
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image from stream
if (size > 0) then
begin
// read the image in a temporary memory stream
pMemStr.CopyFrom(pStream, size);
pMemStr.Position := 0;
// get the graphic class to create
if (imgClassName = 'TWSVGGraphic') then
pGraphicClass := TWSVGGraphic
else
begin
TWLogHelper.LogToCompiler('Internal error - unknown graphic class - '
+ imgClassName + ' - name - ' + Name);
pGraphicClass := nil;
end;
// found it?
if (Assigned(pGraphicClass)) then
begin
pGraphic := nil;
try
// create a matching graphic to receive the image data
pGraphic := pGraphicClass.Create;
pGraphic.LoadFromStream(pMemStr);
pItem.m_pPicture.Assign(pGraphic);
finally
pGraphic.Free;
end;
end;
pMemStr.Clear;
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the color key from stream
if (size > 0) then
begin
Assert(size = SizeOf(color));
pStream.ReadBuffer(color, size);
// get the color key
pItem.m_ColorKey := TWColor.Create((color shr 16) and $FF,
(color shr 8) and $FF,
color and $FF,
(color shr 24) and $FF);
end;
// add item to list
pList.Add(pItem);
except
pItem.Free;
raise;
end;
end;
finally
pMemStr.Free;
end;
end;
Here is the WritePictures function:
procedure TMyImageList.WritePictures(pStream: TStream);
begin
SavePictureListToStream(m_pPictures, pStream);
end;
And finally, here is the SavePictureListToStream function:
procedure TMyImageList.SavePictureListToStream(pList: IWPictureList; pStream: TStream);
var
count, i: Integer;
color: Cardinal;
imgClassName: string;
imgNameBytes: TBytes;
pMemStr: TMemoryStream;
size: Int64;
begin
// write the list count
count := pList.Count;
pStream.WriteBuffer(count, SizeOf(count));
if (count = 0) then
Exit;
pMemStr := TMemoryStream.Create;
try
for i := 0 to count - 1 do
begin
// a picture should always be assigned in the list so this should never happen
if (not Assigned(pList[i].m_pPicture.Graphic)) then
begin
TWLogHelper.LogToCompiler('Internal error - picture list is corrupted - ' + Name);
// write empty size to prevent to corrupt the stream
size := 0;
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(size, SizeOf(size));
end
else
begin
// save the image type in the stream
imgClassName := pList[i].m_pPicture.Graphic.ClassName;
imgNameBytes := TEncoding.UTF8.GetBytes(imgClassName);
size := Length(imgNameBytes);
pStream.WriteBuffer(size, SizeOf(size));
pStream.Write(imgNameBytes, size);
// save the image in the stream
pList[i].m_pPicture.Graphic.SaveToStream(pMemStr);
size := pMemStr.Size;
pStream.WriteBuffer(size, SizeOf(size));
pStream.CopyFrom(pMemStr, 0);
pMemStr.Clear;
end;
// build the key color to save
color := (pList[i].m_ColorKey.GetBlue +
(pList[i].m_ColorKey.GetGreen shl 8) +
(pList[i].m_ColorKey.GetRed shl 16) +
(pList[i].m_ColorKey.GetAlpha shl 24));
// save the key color in the stream
size := SizeOf(color);
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(color, size);
end;
finally
pMemStr.Free;
end;
end;
When the issue occurs, the content get in imgClassName become incoherent, or sometimes the image count read on the LoadPictureListFromStream() function first line is equals to 0.
Writing the DFM stream content in a file, I also noticed that only the class name value is corrupted, other data seems OK.
This issue happens randomly, sometimes all works fine, especially if I start the app in runtime time without previously opening the form in design time, but it may also happen whereas I just open the form in design time, without changing nor saving nothing. On the other hand, this issue happen only with XE2. I never noticed it on any other compiler.
As I'm a c++ developer writing a Delphi code, and as I needed to adapt a part of the code to be able to compile it under XE2 (see the {$if CompilerVersion <= 23} statements), I probably doing something very bad with the memory, but I cannot figure out what exactly.
Can someone analyse this code and point me what is(are) my mistake(s)?
In your SavePictureListToStream() method, the statement
pStream.Write(imgNameBytes, size);
does not work the way you expect in XE2 and earlier. TStream did not gain support for reading/writing TBytes arrays until XE3. As such, the above statement ends up writing to the memory address where the imgNameBytes variable itself is declared on the stack, not to the address where the variable is pointing to, where the array is allocated on the heap.
For XE2 and earlier, you need to use this statement instead:
pStream.WriteBuffer(PByte(imgNameBytes)^, size);
What you have in your LoadPictureListFromStream() method is technically OK, but your UTF-8 handling is more complicated then it needs to be. TEncoding exists in XE2, as it was first introduced in D2009. But even in older versions, you can and should use a dynamic array instead of GetMem() to simplify your memory management and keep it consistent across multiple versions, eg:
{$if CompilerVersion < 18.5}
type
TBytes = array of byte;
{$ifend}
var
imgNameBytes: TBytes;
...
begin
...
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image type from stream
if (size > 0) then
begin
SetLength(imgNameBytes, size{$if CompilerVersion < 20}+1{$ifend});
pStream.ReadBuffer(PByte(imgNameBytes)^, size);
{$if CompilerVersion < 20}
imgNameBytes[High(imgNameBytes)] := $0;
imgClassName := UTF8ToString(PAnsiChar(pImgNameBytes));
{$else}
imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
{$ifend}
end;
...
end;