Delphi XE2 - поток DFM случайно пуст или поврежден во время вызова функции чтения функции - PullRequest
1 голос
/ 07 июля 2019

Я создаю пакет, в котором пользовательский список изображений читает и записывает свое содержимое в файл 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 в файл, я также заметил, что повреждено только значение имени класса, другие данные выглядят нормально.

Эта проблема возникает случайным образом, иногда все работает нормально, особенно если я запускаю приложение во время выполнения без предварительного открытия формы во время разработки, но это также может произойти, тогда как я просто открываю форму во время разработки, не меняя и не сохраняя ничего.С другой стороны, эта проблема возникает только с XE2.Я никогда не замечал этого ни в одном другом компиляторе.

Поскольку я - разработчик на С ++, пишу код на Delphi, и мне нужно было адаптировать часть кода, чтобы иметь возможность компилировать его под XE2 (см. {$ if CompilerVersion <= 23}), я, вероятно, делаю что-то очень плохое с памятью, но не могу понять, что именно. </p>

Может кто-нибудь проанализировать этот код и указать мне, в чем заключается моя ошибка (s)

1 Ответ

5 голосов
/ 07 июля 2019

В вашем методе SavePictureListToStream() оператор

pStream.Write(imgNameBytes, size);

не работает так, как вы ожидаете в XE2 и более ранних версиях.TStream не получал поддержку чтения / записи массивов TBytes до XE3.Таким образом, вышеприведенный оператор заканчивает запись в адрес памяти, где переменная 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)] := $0;
    imgClassName := UTF8ToString(PAnsiChar(pImgNameBytes));
    {$else}
    imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
    {$ifend}
  end;
  ...
end;
...