在 Windows Server 2008 (sp1) 上运行的 Delphi 应用程序是否不会回收内存？

Question

我们有一个 D2007 应用程序，当在 Windows Server 2008（x64、sp1）上运行时，其内存占用量会稳定增长。
它在 Windows Server 2003（x32 或 x64）、XP 等上表现正常...它按预期上下波动。
我们尝试使用附带的内存管理器或最新的 FastMM4 4.92，得到相同的结果。

有没有人尝试在 Win2008 上监视任何 Delphi 应用程序的内存使用情况并确认？
或者会有什么线索吗？

精度：
- 常识上没有内存泄漏（是的，我对 FastMM 等人非常熟悉）
- 使用 Process Explorer 监控内存使用情况； Win2008 上的虚拟内存（专用字节）和物理内存（专用工作集）都在增长
- 即使存在内存压力，内存消耗仍在增长。 （这就是我们进行调查的方式，因为它导致了失败，但仅限于 Win2008 机器）

更新： //** 重新调整的 **// 代码比我们的应用程序简单得多，但显示了相同的行为.
创建一个包含 10,000,000 个对象的列表，然后创建 10,000,000 个接口，执行 2 次，使用的内存会增加约 60MB，在 Windows Server 2008 上再执行 100 次，会增加大约 300MB，但只会返回到 XP 上的情况。
如果您启动多个实例，则不会释放内存以允许其他实例运行。 相反，页面文件会增长并且服务器会爬行...

更新 2：请参阅 QC报告73347
经过进一步调查，我们追踪到关键部分，如下面的代码所示。
将该代码放入带有按钮的简单 VCL 应用程序中。 并使用 Process Explorer 进行监控：
它开始时约为 2.6 MB，运行 5 次后（单击按钮），它保持在 ~118.6MB。
5 次执行中丢失了 116MB。

//***********************
const
  CS_NUMBER = 10000000;
type
  TCSArray = Array[1..CS_NUMBER] of TRTLCriticalSection;
  PCSArray = ^TCSArray;

procedure TestStatic;
var
  csArray: PCSArray;
  idx: Integer;
begin
  New(csArray);

  for idx := 1 to length(csArray^) do
    InitializeCriticalSection(csArray^[idx]);

  for idx := 1 to length(csArray^) do
      DeleteCriticalSection(csArray^[idx]);

  Dispose(csArray);
end;

procedure TestDynamic(const Number: Integer);
var
  csArray: array of TRTLCriticalSection;
  idx: Integer;
begin
  SetLength(csArray, Number);

  for idx := Low(csArray) to High(csArray) do
    InitializeCriticalSection(csArray[idx]);

  for idx := Low(csArray) to High(csArray) do
      DeleteCriticalSection(csArray[idx]);
end;

procedure TForm4.Button1Click(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
  TestStatic;
  TestDynamic(CS_NUMBER);
end;

Answer 1

有一个名为 VMMap 的新 sysinternals 工具，它可以可视化分配的内存。 也许它可以向您展示大内存块是什么。

Answer 2

实际上，微软对关键部分进行了更改以添加一些调试信息。 此调试内存直到应用程序结束时才会释放，但会以某种方式缓存和重用，这就是为什么在一段时间后它会趋于稳定。

如果您想创建大量关键部分而不感到内存损失，解决方案是修补 VCL 代码，以通过调用 来替换对 InitializeCriticalSection 的调用>InitializeCriticalSectionEx 并向其传递标志 CRITICAL_SECTION_NO_DEBUG_INFO 以避免创建调试结构。

Answer 3

您是否包含具有完整调试模式的 FastMM？ 只需将 FastMM4 单元直接包含在您的项目中并设置

ReportMemoryLeaksOnShutdown := True

如果没有报告任何内容，则可能在程序退出时通常会释放所有内容（可能是因为引用计数）。 您可以使用 AQTime 实时监控内存。 通过此应用程序，您可以查看每个类名称和其余已用内存的“计数”字节数。 也许您可以看到谁使用了内存。 限时演示版本足以胜任这项工作。

Answer 4

您指的是私有字节、虚拟大小还是工作集？ 运行 来自 SysInternals 的 Process Explorer 来监视内存，以便更好地了解到底是怎么回事。

我对此没有任何具体经验（尽管我运行的是 2008 x64 SP1，因此可以测试它），但我建议您创建一个测试应用程序来分配一堆内存，然后释放它。 运行来自 SysInternals 的 Process Explorer 来监视内存。

如果您测试应用程序重现相同的行为，则尝试通过在另一个进程中分配内存来创建一些内存压力 - 压力太大，除非回收第一个进程中先前释放的内存，否则它将失败。

如果仍然失败，请尝试不同的内存管理器。 也许是 FastMM 正在做这件事。

Answer 5

检查您是否有此问题（这是另一个问题，与那个，我在对你的问题的评论中提到过）。

Answer 6

我编写此代码是为了纠正我的应用程序上的此问题。
与 FastCode 的情况相同，要使修复运行，您必须将该单元作为项目的第一个单元。
就像本例中的 uRedirectionamentos 一样：

unit uCriticalSectionFix;
// By Rodrigo F. Rezino - [email protected]

interface

uses
  Windows;

implementation

uses
  SyncObjs, SysUtils;

type
  InitializeCriticalSectionExProc = function(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD; Flags: DWORD): BOOL; stdcall;

var
  IsNewerThenXP: Boolean;
  InitializeCriticalSectionEx: InitializeCriticalSectionExProc;

type
  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: Pointer;
  end;

  TCriticalSectionHack = class(TSynchroObject)
  protected
    FSection: TRTLCriticalSection;
  public
    constructor Create;
  end;

function GetMethodAddress(AStub: Pointer): Pointer;
const
  CALL_OPCODE = $E8;
begin
  if PBYTE(AStub)^ = CALL_OPCODE then
  begin
    Inc(Integer(AStub));
    Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^);
  end
  else
    Result := nil;
end;

procedure AddressPatch(const ASource, ADestination: Pointer);
const
  JMP_OPCODE = $E9;
  SIZE = SizeOf(TJump);
var
  NewJump: PJump;
  OldProtect: Cardinal;
begin
  if VirtualProtect(ASource, SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    NewJump := PJump(ASource);
    NewJump.OpCode := JMP_OPCODE;
    NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5);

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump));
    VirtualProtect(ASource, SIZE, OldProtect, @OldProtect);
  end;
end;

procedure OldCriticalSectionMethod;
asm
  call TCriticalSection.Create;
end;

{ TCriticalSectionHack }

const
  CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;
  NEW_THEN_XP = 6;

constructor TCriticalSectionHack.Create;
begin
  inherited Create;
  if IsNewerThenXP then
    InitializeCriticalSectionEx(FSection, 0, CRITICAL_SECTION_NO_DEBUG_INFO)
  else
    InitializeCriticalSection(FSection);
end;

procedure AdjustMethod;
var
  LKernel32: HModule;
begin
  if IsNewerThenXP then
  begin
    LKernel32 := LoadLibrary('kernel32.dll');
    @InitializeCriticalSectionEx := GetProcAddress(LKernel32, 'InitializeCriticalSectionEx');
  end;
end;

initialization
  AddressPatch(GetMethodAddress(@OldCriticalSectionMethod), @TCriticalSectionHack.Create);
  IsNewerThenXP := CheckWin32Version(NEW_THEN_XP, 0);
  AdjustMethod;


end.

Answer 7

除了Alexander之外，通常这被称为“堆碎片”。

请注意，FastMM 总体上应该更具弹性和更快，但如果原始应用程序针对 D7 memmanager 进行了调整，FastMM 实际上可能表现更差。

Answer 8

即使应用程序中没有内存泄漏，内存使用量也会增加。 在这些情况下，您可能会泄漏其他资源。 例如，如果您的代码分配了一个位图，尽管它释放了所有对象，但设法忘记了完成某些 HBITMAP。

FastMM 会告诉您应用程序中没有内存泄漏，因为您已经释放了所有对象和数据。 但您仍然会泄漏其他类型的资源（在我的示例中 - GDI 对象）。 泄漏其他类型的资源也会影响您的记忆。

我建议您尝试其他工具，它不仅检查内存泄漏，还检查其他类型的泄漏。 我认为 AQTime 有能力做到这一点，但我不确定。

此行为的另一个可能原因是内存碎片。 假设您分配了 2000 个 1 Mb 大小的对象（让我们暂时忘记 MM 开销和用户空间中另一个对象的存在）。 现在您已拥有 2 GB 的繁忙内存。 现在，假设您释放了所有偶数对象，那么现在您已经“剥离”了内存空间，其中 1 Mb 的繁忙块和空闲块混合在一起。 虽然您现在确实有 1 Gb 的空闲内存，但您无法为任何 2 Mb 对象分配内存，因为空闲块的最大大小仅为 1 Mb（但您确实有 1000 个这样的块;)）。
如果内存管理器为您的对象使用了大于 1 Mb 的块，那么当您释放偶数对象时，它无法将内存块释放回操作系统：

[ [busy] [free] [busy] [free] [busy] [free] ]
[ [busy] [free] [busy] [free] [busy] [free] ]...

这些大块处于半忙状态，因此 MM 无法将它们交给操作系统。 如果您要求另一个块，即 > 1 Mb，则 MM 将需要从操作系统分配另一个块：

[ [busy] [free] [busy] [free] [busy] [free] ]
[ [busy] [free] [busy] [free] [busy] [free] ]...
[ [your-new-object] [free.................] ]

请注意，这些只是增加内存使用量的示例，尽管您没有内存泄漏。 我并不是说你有确切的情况：D