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}语句),所以我可能会做一些非常内存不好,但我无法弄清楚到底是什么。
有人可以分析此代码并指出我的错误是什么吗?
用你的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)