Google

Tuesday, March 13, 2007

detect memory leaks

procedure TForm.DebugProcessStatus(s: string);
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
MemStat: tMemoryStatus;
begin
MemStat.dwLength := SizeOf(MemStat);
GlobalMemoryStatus(MemStat);

// Get the total and available system memory
TotalMemoryLabel.Caption := 'Total system memory: ' +
FormatFloat('###,###', MemStat.dwTotalPhys / 1024) + ' KByte';
FreeMemoryLabel.Caption := 'Free physical memory: ' +
FormatFloat('###,###', MemStat.dwAvailPhys / 1024) + ' KByte';

// Get the used memory for the current process
cb := SizeOf(TProcessMemoryCounters);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
begin
NewWorkingMemory := Longint(pmc^.WorkingSetSize);
ProcessMemoryLabel.Caption := 'Process-Memory: ' +
FormatFloat('###,###', NewWorkingMemory / 1024) + ' KByte';
MemoryLeakLabel.Caption := 'Memory Loss: ' +
FormatFloat('###,###', (NewWorkingMemory - OldWorkingMemory) / 1024) + ' KByte';
OldWorkingMemory := NewWorkingMemory;
end;
FreeMem(pmc);

DebugStatusLabel.Caption := 'Status: ' + s;
end;

No comments: