Delphi 截图泄漏？

大家晚上好

在当前的一个项目中，我遇到了一个相当令人担忧的内存泄漏，我似乎无法堵塞它

我让应用程序在标准使用情况下运行了一夜，8小时后醒来时，它消耗了约750MB的内存，而启动时的内存约为50MB。Windows任务管理器不适合检查泄漏，只允许您首先发现存在泄漏

我已经清除了其他一些内存泄漏，其中主要的一个与Firemonkey的

TGlowEffect

有关。

ReportLeaksOnShutdown

没有检测到它，但在动态修改的对象上（例如旋转或缩放变化），它的内存使用变得非常过度

我已经找到了一个计时器（禁用它可以完全阻止泄漏），如果可能的话，我需要帮助修复它

说明：此代码使用Firemonkey

MakeScreen shot

功能将

TPanel（SigPanel）

的视觉外观保存到

TMemoryStream

。然后使用标准代码将该流数据上载到远程FTP服务器（见下文）。在

SigPanel

内部，有4个

TLabel

子级、1个

TRectangle

子级和6个

TImage

子级

注释：

CfId

是一个全局字符串，基于随机的

扩展的

浮点值生成，该浮点值随后与格式为

yyyymmdd_hhnnszzz

的日期时间一起散列。此生成在创建表单时完成，并重复生成，直到它成为有效的

CfId

（即不包含在Windows文件名中使用的非法字符）。一旦它得到一个有效的

CfId

，它就不再运行了（因为我不再需要生成新的ID）。这使我几乎完全消除了重复的机会

CfId

计时器中的代码如下所示

var
  i : Integer;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  SigPanel.MakeScreenshot.SaveToStream(SigStream);
  SigPanel.MakeScreenshot.Free;
  if VT2SigUp.Connected then
  begin
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end else
  begin
    VT2SigUp.Connect;
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end;
    SigStream.Free;
end;

Small Block Leaks

1 - 12 Bytes: Unknown x 1
13 - 20 Bytes: TList x 5, Unknown x 1
21 - 28 Bytes: TFont x 2, TGradientPoint x 8, TGradientPoints x 4, Unknown x 4
29 - 36 Bytes: TObjectList<FMX.Types.TCanvasSaveState> x 1, TBrushBitmap x 4,
TBrushGrab x 4, TPosition x 24, TGradient x 4, UnicodeString x1
37 - 44 Bytes: TBrushResource x 4
53 - 60 Bytes: TBrush x 4
61 - 68 Bytes: TBitmap x 5
69 - 76 Bytes: TD2DCanvasSaveState x 1
205 - 220 Bytes: TCanvasD2D x 1

Sizes of Medium and Large Block Leaks
200236

计时器未运行时，代码完全正常运行，不会泄漏，并且

ReportMemoryLeaksOnShutdown

不会生成消息。随着定时器的启用和被允许“运行”至少一次，我得到了大量的泄漏，这增加了定时器运行的次数。报告的泄漏情况如下：

var
  i : Integer;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  SigPanel.MakeScreenshot.SaveToStream(SigStream);
  SigPanel.MakeScreenshot.Free;
  if VT2SigUp.Connected then
  begin
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end else
  begin
    VT2SigUp.Connect;
    VT2SigUp.Put(SigStream,'Sig_'+CfId+'.png',False);
  end;
    SigStream.Free;
end;

Small Block Leaks

1 - 12 Bytes: Unknown x 1
13 - 20 Bytes: TList x 5, Unknown x 1
21 - 28 Bytes: TFont x 2, TGradientPoint x 8, TGradientPoints x 4, Unknown x 4
29 - 36 Bytes: TObjectList<FMX.Types.TCanvasSaveState> x 1, TBrushBitmap x 4,
TBrushGrab x 4, TPosition x 24, TGradient x 4, UnicodeString x1
37 - 44 Bytes: TBrushResource x 4
53 - 60 Bytes: TBrush x 4
61 - 68 Bytes: TBitmap x 5
69 - 76 Bytes: TD2DCanvasSaveState x 1
205 - 220 Bytes: TCanvasD2D x 1

Sizes of Medium and Large Block Leaks
200236

小块泄漏
1-12字节：未知x 1
13-20字节：TList x 5，未知x 1
21-28字节：TFont x 2，TGradientPoint x 8，TGradientPoints x 4，未知x 4
29-36字节：TObjectList x 1，TBrushBitmap x 4，
TBRUSH抓斗x 4，t位置x 24，t半径x 4，单轴压缩x1
37-44字节：TBrushResource x 4
53-60字节：TBX 4
61-68字节：TBitmap x 5
69-76字节：TD2DCanvasSaveState x 1
205-220字节：TCanvasD2D x 1
中型和大型块状泄漏的尺寸
200236

当计时器运行时，这些值乘以n次（n是计时器运行的次数）。中型和大型块的n值为200236（例如，如果计时器已运行3次，则为200236、200236、200326）

有趣的是，如果我删除与

MakeScreenshot

关联的代码，泄漏将不再存在，内存使用率将保持在正常水平。除了通常的内存使用，没有异常情况，也没有泄漏报告。我尝试了多个代码示例，都是保存到流并从那里上载，或者保存到流>文件然后上载文件，但函数本身似乎存在漏洞。我甚至添加了

MakeScreenshot.Free

一旦我发现这里有漏洞，但我似乎根本无法堵住它，当然，我已经在我的一个代码“测试运行”中使用了

try..finally

我甚至使用GDI+作为canvas类型运行代码，在那里发生了相同的泄漏（唯一的变化是D2D泄漏引用GDI+）

---

我非常感谢任何人在这方面所做的研究或笔记，以及解决这个问题的方法。

您没有释放

制作屏幕截图

创建的位图

procedure TForm1.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  Panel1.MakeScreenshot.SaveToStream(ms);
  ms.Free;
end;

上面的代码没有保留对创建的位图的引用，因此没有机会释放它。改为按以下方式更改您的设计：

procedure TForm1.Button2Click(Sender: TObject);
var
  ms: TMemoryStream;
  bmp: TBitmap;
begin
  ms := TMemoryStream.Create;
  bmp := Panel1.MakeScreenshot;
  bmp.SaveToStream(ms);
  ms.Free;
  bmp.Free;
end;

var
  i : Integer;
  Bmp: TBitmap;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  try
    Bmp := SigPanel.MakeScreenshot;
    try
      Bmp.SaveToStream(SigStream);
      if not VT2SigUp.Connected then
        VT2SigUp.Connect;
      VT2SigUp.Put(SigStream, 'Sig_'+CfId+'.png', False);
    finally
      Bmp.Free;
    end;
  finally
    SigStream.Free;
  end;
end;

使用下面的代码，实际上您正在创建两个位图并释放其中一个

  SigPanel.MakeScreenshot.SaveToStream(SigStream);
  SigPanel.MakeScreenshot.Free;

最后，您的代码将更像以下代码：

procedure TForm1.Button2Click(Sender: TObject);
var
  ms: TMemoryStream;
  bmp: TBitmap;
begin
  ms := TMemoryStream.Create;
  bmp := Panel1.MakeScreenshot;
  bmp.SaveToStream(ms);
  ms.Free;
  bmp.Free;
end;

var
  i : Integer;
  Bmp: TBitmap;
  SigStream : TMemoryStream;
begin
  SigStream := TMemoryStream.Create;
  try
    Bmp := SigPanel.MakeScreenshot;
    try
      Bmp.SaveToStream(SigStream);
      if not VT2SigUp.Connected then
        VT2SigUp.Connect;
      VT2SigUp.Put(SigStream, 'Sig_'+CfId+'.png', False);
    finally
      Bmp.Free;
    end;
  finally
    SigStream.Free;
  end;
end;

---

我相信你刚刚在FM中发现了内存泄漏（：我相信在应用程序的初始化中设置

ReportMemoryLeaksOnShutdown:=True；

应该可以让你知道泄漏了什么…@DorinDuminica我相信是这样的。但是，我相信我已经发现问题在于

FMX.Types.MakeScreenshot

中的

结果

实际上没有被释放。他们只是调用

Result.Canvas.EndScene

而且永远也不会释放它！@Jerrydoge这就是我跑去找出泄漏的东西的原因，没有它我就无法得到一份准确的清单：）抱歉，在没有阅读全部内容的情况下发布了这篇文章，目前正在验证释放结果是否是必需的修复，并且不会导致任何奇怪的错误弹出。将在几个小时后发布答案。我希望这是需要的，但我想让它运行一段时间以确定。到目前为止，由于内存使用保持稳定，结果看起来很有希望e、 补充@Sertac answear别忘了使用try finally来避免put上的错误，并避免memorystream泄漏，因为它是SigStream。如果引发任何异常，将不会调用Free。啊，没错，就是这样。这似乎是一个非常冗长的过程，最初看起来好像结果没有在

FMX.Types中释放e> 。我假设必须调用
MakeScreenshot
并提供一个引用（例如流），但看到您是如何做到的，确实让我理解了如何正确使用该函数。正如我所说，我确实使用了
try.。最后，在我的一个代码修复程序中使用了
，但为了尽可能简化代码，我将其取出