Delphi XE2 - DFM 流在调用读取函数回调时随机为空或损坏

Question

我正在创建一个包，其中自定义图像列表在 DFM 文件中读取和写入其内容。

我编写的代码在 XE7 和 10.3 Rio 之间的所有编译器中都运行良好。但是我在 XE2 中遇到了一个奇怪的问题。使用这个特定的编译器，我有时会在读取 DFM 时收到空流内容，有时会收到损坏的内容。

我的自定义图像列表是在标准 TImageList 之上构建的。我以这种方式注册我的阅读回调：

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;

这是 ReadPictures 函数：

procedure TMyImageList.ReadPictures(pStream: TStream);
begin
    LoadPictureListFromStream(m_pPictures, pStream);
end;

这是 LoadPictureListFromStream 函数：

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;

这是 WritePictures 函数：

procedure TMyImageList.WritePictures(pStream: TStream);
begin
    SavePictureListToStream(m_pPictures, pStream);
end;

最后，这里是 SavePictureListToStream 函数：

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;

出现该问题时，imgClassName 中获取的内容变得不连贯，或者有时在 LoadPictureListFromStream() 函数第一行读取的图像计数等于 0。

在文件中写入 DFM 流内容时，我还注意到只有 class 名称值损坏，其他数据似乎没问题。

这个问题是随机发生的，有时一切正常，特别是如果我在运行时启动应用程序而没有事先在设计时打开表单，但它也可能发生在我只是在设计时打开表单而没有更改也不节省任何东西。另一方面，这个问题只发生在 XE2 上。我从来没有在任何其他编译器上注意到它。

因为我是一名编写 Delphi 代码的 c++ 开发人员，并且我需要修改部分代码以便能够在 XE2 下编译它（请参阅 {$if CompilerVersion <= 23 } 语句），我可能对内存做了一些非常糟糕的事情，但我无法弄清楚到底是什么。

有人可以分析这段代码并指出我的错误是什么吗？

Answer 1

在您的 SavePictureListToStream() 方法中，语句

pStream.Write(imgNameBytes, size);

在 XE2 和更早版本中的工作方式与您预期的不同。 TStream 直到 XE3 才获得对 reading/writing TBytes 数组的支持。因此，上面的语句最终写入了 imgNameBytes 变量本身在堆栈上声明的内存地址，而不是变量指向的地址，数组在堆上分配的地址。

对于 XE2 及更早版本，您需要改用此语句：

pStream.WriteBuffer(PByte(imgNameBytes)^, size);

您的 LoadPictureListFromStream() 方法在技术上是可以的，但是您的 UTF-8 处理比它需要的更复杂。 TEncoding 存在于 XE2 中，因为它在 D2009 中首次引入。但即使在旧版本中，您也可以而且应该使用动态数组而不是 GetMem() 来简化内存管理并在多个版本中保持一致，例如：

{$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)] := [=12=];
    imgClassName := UTF8ToString(PAnsiChar(pImgNameBytes));
    {$else}
    imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
    {$ifend}
  end;
  ...
end;

Delphi XE2 - DFM 流在调用读取函数回调时随机为空或损坏

Delphi XE2 - DFM stream is randomly empty or corrupted while read function callback is called

delphi

corruption

dfm

delphi-xe2