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

Jea*_*ond 1 delphi corruption dfm delphi-xe2

我正在创建一个程序包,其中自定义图像列表在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;
Run Code Online (Sandbox Code Playgroud)

这是ReadPictures函数:

procedure TMyImageList.ReadPictures(pStream: TStream);
begin
    LoadPictureListFromStream(m_pPictures, pStream);
end;
Run Code Online (Sandbox Code Playgroud)

这是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;
Run Code Online (Sandbox Code Playgroud)

这是WritePictures函数:

procedure TMyImageList.WritePictures(pStream: TStream);
begin
    SavePictureListToStream(m_pPictures, pStream);
end;
Run Code Online (Sandbox Code Playgroud)

最后,这是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;
Run Code Online (Sandbox Code Playgroud)

发生问题时,在imgClassName中获取的内容变得不一致,或者有时在LoadPictureListFromStream()函数的第一行读取的图像计数等于0。

将DFM流内容写入文件时,我还注意到只有类名值已损坏,其他数据似乎还可以。

这个问题是随机发生的,有时一切正常,特别是如果我在运行时启动应用程序而没有在设计时事先打开表单的情况下,但是也可能发生,而我只是在设计时打开了表单,而没有更改或不保存任何内容。另一方面,仅XE2会发生此问题。我从未在其他任何编译器上注意到它。

由于我是一名编写Delphi代码的c ++开发人员,并且需要修改部分代码以便能够在XE2下进行编译(请参见{$ if CompilerVersion <= 23}语句),所以我可能会做一些非常内存不好,但我无法弄清楚到底是什么。

有人可以分析此代码并指出我的错误是什么吗?

Rem*_*eau 5

用你的SavePictureListToStream()方法,语句

pStream.Write(imgNameBytes, size);
Run Code Online (Sandbox Code Playgroud)

不能像您在XE2和更早版本中所期望的那样工作。直到XE3 TStream才获得对读/写TBytes阵列的支持。这样,上面的语句最终写到imgNameBytes在堆栈上声明变量本身的内存地址,而不是写变量指向的地址,在堆上分配数组的地址。

对于XE2和更早版本,您需要使用以下语句:

pStream.WriteBuffer(PByte(imgNameBytes)^, size);
Run Code Online (Sandbox Code Playgroud)

LoadPictureListFromStream()技术上讲,您所拥有的方法是可以的,但是您的UTF-8处理要复杂得多。TEncodingXE2中首次存在D2。但是,即使在较旧的版本中,您也可以并且应该使用动态数组,而不是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)] := $0;
    imgClassName := UTF8ToString(PAnsiChar(pImgNameBytes));
    {$else}
    imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
    {$ifend}
  end;
  ...
end;
Run Code Online (Sandbox Code Playgroud)