Is the memory fixed for Delphi applications on Windows Server 2008 (sp1)?

We have a D2007 application, the memory capacity of which is steadily growing when working on Windows Server 2008 (x64, sp1).
It works fine on Windows Server 2003 (x32 or x64), XP, etc., where it goes up and down as expected.
We tried with the memory manager turned on or the latest FastMM4 4.92 with the same results.

Has anyone tried to control the memory usage of any Delphi application on Win2008 and would confirm?
Or do you have a key?

Precisions:
- there are no memory leaks in common sense (and yes, I am well acquainted with FastMM and others)
- memory was used using Process Explorer; both virtual memory (private bytes) and physical memory (WorkingSet Private) grow on Win2008
- memory consumption still increased even when there was memory pressure. (that we came to an investigation because it caused a crash, but only on Win2008)

Update : // ** repaced ** // the code is much simpler than our application, but it shows the same behavior.
Creating a list of 10,000,000 objects, and then 10,000,000 completed interfaces in 2 times, increases the used memory by ~ 60 MB and more than 300 MB by 100 additional executions in Windows Server 2008, but simply returns to where it was on XP .
If you run multiple instances, memory will not be released to allow other instances to run. Instead, the page file grows and the server scans ...

2: . QC 73347
, .
VCL . Process Explorer:
~ 2,6 5 ( ) ~ 118,6 .
116 5 .

//***********************
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;
+3
8

, Microsoft , . , - , - .

, , , - VCL, InitializeCriticalSection InitializeCriticalSectionEx CRITICAL_SECTION_NO_DEBUG_INFO, .

+3

sysinternals, VMMap, . , , .

+3

FastMM ? FastMM4

ReportMemoryLeaksOnShutdown := True

, , (, - ). AQTime . "" . , , . .

+1

, ? Process Explorer SysInternals, , .

( 2008 x64 SP1, ), , , . Process Explorer SysInternals, .

, , , - , , .

, . , FastMM.

+1

, ( , , ).

+1

, . FastCode, , . uRedirecionamentos : enter image description here

unit uCriticalSectionFix;
// By Rodrigo F. Rezino - rodrigofrezino@gmail.com

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.
+1

, " ".

, FastMM , memmanager D7, FastMM .

0

, , . , . , , , , , HBITMAP.

FastMM , , . ( - GDI). .

, , . , AQTime , .

. , 2000 1 ( MM ). 2 . , , "" , 1 Mb . 1 , 2Mb, 1 ( 1000 ;)). 1 , , :

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

These large blocks are [...] half full, so MM cannot provide their OS. If you ask for another block that is> 1 MB, then MM will need to select another block from the OS:

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

Note that these are just memory usage examples, although you do not have a memory leak. I'm not saying that you have an EXACT situation: D

-1
source

All Articles