Leak Watcher Tool - 重载内存分配
Posted
技术标签:
【中文标题】Leak Watcher Tool - 重载内存分配【英文标题】：Leak Watcher Tool - Overloading the memory allocation 【发布时间】：2012-10-04 18:12:49 【问题描述】：我正在开发一个工具来帮助我找到我的应用程序的内存泄漏。 该功能在我使用对象 (TOBJECT) 时运行良好，但在使用缓冲区时遇到了一些问题。 在某些情况下，我无法识别我的应用程序中出现了一些错误，这些错误似乎是对内存的一些错误访问。我在我的逻辑或代码上找不到任何可能的错误。如果有更多的德尔福经验的人可以帮助我。也许某些内存管理器的特定行为导致了问题。
多一点解释：
内存分配控制
目的：统计系统分配了多少确定大小的内存缓冲区，例如：
缓冲区大小 |分配数量 |使用的总内存
325 | 35265 | 11461125
23 | 32 | 736
... | ... | ...
我如何控制内存分配和释放：
I created an array of integer that goes from 0 to 65365. This array will be used to keep the amount of allocs of the corresponding size.
For example, If I call GetMem for a buffer of 523, the Array[523] will increase + 1.
The GetMem, ReallocMem, AllocMem, the problem is easy to resolve 'cause one of it's parameters is the size of the buffer. So I can use this to increase the position of the array.
The problem cames with the FreeMem, 'cause the only parameter is the pointer of the buffer. I don't know it's size.
- I can't create a list to keep the Pointer and it's size. 'Cause there is SO much allocations, it will be so much expensive to the application keep searching/adding/removing items from this list. And this list must to be protected with critical section etc etc. So no way.
How I'm trying to solve this problem:
Just to remeber I created the array to keep the number off allocations.
Items: 0 65365
|................................|
Addess: $X $(65365x SizeOf(Integer))
When allocators methos are called, for example: GetMem(52);
I changed the behavior of it, I will alloc the requested size (52), but I'll add here a size of an integer;
So I will have:
0 4 56
|.....|...........................|
$x
In the plus space (0..3) I'll set the address of the corresponding space of the array. In this case the address position $array(52). And I add + (SizeOf(Integer)) to the address result of the GetMem, so it will have access just the 52 bytes that were asked for.
When the FreeMem are called. What I do is:
- Get the pointer asked for deallocation.
- Decrease the pointer by the size of the integer
- Check if the address of the current pointer is relative to the Array of control address.
- If it is, I use the the address and decrease 1 from the Array position
- And ask for the FreeMem
在大部分时间和系统中，它运行良好。但是，在某些时候，我真的不知道如何以及是否在系统中遇到了一些奇怪的错误。如果我停用此实现，我永远不会得到错误。
我正在注释代码以便更容易理解，但这不是硬代码，所以这里是：
其他线程：https://forums.embarcadero.com/thread.jspa?threadID=77787
unit uInstancesAnalyser;
Functionality: The feature developed in this unit try to watch how the memory are being allocated by your system. The main focus of it is help to find memory leak in the most non intrusive way.
How to Install: Put this unit as the first unit of yout project. If use use a third memory manager put this unit just after the unit of your memory manager.
How to get it's report: It's not the final version of this unit, so the viewer was not developed. By the momento you can call the
method SaveInstancesToFile. It'll create a text file called MemReport in the executable path.
WARNING: If you use the pointer of the VMT destinated to vmtAutoTable, you should not use the directive TRACEINSTANCES.
How it works:
The feature work in two different approaches:
1) Map the memory usage by objects
2) Map the memory usage by buffers (Records, strings and so on)
How are Objects tracked:
The TObject.NewInstance was replaced by a new method (TObjectHack.NNewInstanceTrace).
So when the creation of an object is called it's redirect to the new method. In this new method is increased the counter of the relative class and change the method in the VMT that is responsible to free the object to a new destructor method (vmtFreeInstance). This new destructor call the decrease of the counter and the old destructor.
This way I can know how much of objects of each class are alive in the system.
(More details about how it deep work can be found in the comments on the code)
How are Memory Buffer Traced:
The GetMem, FreeMem, ReallocMem, AllocMem were replaced by new method that have an special behavior to help track the buffers.
As the memory allocation use the same method to every kind of memory request, I'm not able to create a single counter to each count of buffer. So, I calculate them base on it size. First I create a array of integer that start on 0 and goes to 65365.
When the system ask me to give it a buffer of 65 bytes, I increase the position 65 of the array and the buffer is deallocated I call the decrease of the position of the array corresponding to buffer size. If the size requested to the buffer is bigger or equal to 65365, I'll use the position 65365 of the array.
(More details about how it deep work can be found in the comments on the code)
--------------------------------------------------------------------------------------
Develop by Rodrigo Farias Rezino
E-mail: rodrigofrezino@gmail.com
***: http://***.com/users/225010/saci
Please, any bug let me know
interface
$DEFINE TRACEBUFFER Directive used to track buffer //Comment to inactive
$DEFINE TRACEINSTANCES Directive used to track objects //Comment to inactive
//$DEFINE WATCHTHREADS // It's not finished
uses
Classes, SyncObjs, uIntegerList;
You can register possibles names for some Buffers Sizes, it can be useful when you are working with record. Example
TRecordTest = record
Field1: Integer
Field2: string[50]
So, you can call RegisterNamedBuffer(TRecordTest, SizeOf(TRecordTest));
This way, in on the report of buffer/objects will be explicit what possibles named buffer can be that memory in use.
procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);
This function return the possible named buffers registered with that size
function GetBufferName(ASize: integer): string;
It's a simple output to save the report of memory usage on the disk. It'll create a file called test.txt in the executable directory
procedure SaveInstancesToFile;
var
Flag to say if the memory watcher is on or off
SIsMemoryWatcherActive: Boolean;
implementation
uses
Windows, SysUtils, TypInfo;
const
SIZE_OF_INT = SizeOf(Integer);
SIZE_OF_MAP = 65365;
$IFDEF WATCHTHREADS
GAP_SIZE = SIZE_OF_INT * 2;
$ELSE
GAP_SIZE = SIZE_OF_INT;
$ENDIF
type
TArrayOfMap = array [0..SIZE_OF_MAP] of Integer;
TThreadMemory = array [0..SIZE_OF_MAP] of Integer;
This class is used to Register
TNamedBufferList = class(TIntegerList)
public
constructor Create;
function GetBufferName(ASize: integer): string;
procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);
end;
PClassVars = ^TClassVars;
TClassVars = class(TObject)
private
class var ListClassVars: TList;
public
BaseInstanceCount: Integer;
BaseClassName: string;
BaseParentClassName: string;
BaseInstanceSize: Integer;
OldVMTFreeInstance: Pointer;
constructor Create;
class procedure SaveToDisk;
end;
TNamedBuffer = class(TObject)
Names: string;
end;
PJump = ^TJump;
TJump = packed record
OpCode: Byte;
Distance: Pointer;
end;
TObjectHack = class(TObject)
private
FCriticalSection: TCriticalSection;
class procedure SetClassVars(AClassVars: TClassVars); //inline;
class function GetClassVars: TClassVars; inline;
procedure IncCounter; inline;
procedure DecCounter; inline;
procedure CallOldFunction;
public
constructor Create;
destructor Destroy; override;
class function NNewInstance: TObject;
class function NNewInstanceTrace: TObject;
procedure NFreeInstance;
end;
var
SDefaultGetMem: function(Size: Integer): Pointer;
SDefaultFreeMem: function(P: Pointer): Integer;
SDefaultReallocMem: function(P: Pointer; Size: Integer): Pointer;
SDefaultAllocMem: function(Size: Cardinal): Pointer;
SThreadMemory: TThreadMemory;
SMap: TArrayOfMap;
SNamedBufferList: TNamedBufferList;
$IFDEF WATCHTHREADS
SMissedMemoryFlow: Integer;
$ENDIF
$REGION 'Util'
type
TWinVersion = (wvUnknown, wv95, wv98, wv98SE, wvNT, wvME, wv2000, wvXP, wvVista, wv2003, wv7);
function GetWinVersion: TWinVersion;
var
osVerInfo: TOSVersionInfo;
majorVersion, minorVersion: Integer;
begin
Result := wvUnknown;
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(osVerInfo) then
begin
minorVersion := osVerInfo.dwMinorVersion;
majorVersion := osVerInfo.dwMajorVersion;
case osVerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if majorVersion <= 4 then
Result := wvNT
else if (majorVersion = 5) and (minorVersion = 0) then
Result := wv2000
else if (majorVersion = 5) and (minorVersion = 1) then
Result := wvXP
else if (majorVersion = 5) and (minorVersion = 2) then
Result := wv2003
else if (majorVersion = 6) then
Result := wvVista
else if (majorVersion = 7) then
Result := wv7;
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
if (majorVersion = 4) and (minorVersion = 0) then
Result := wv95
else if (majorVersion = 4) and (minorVersion = 10) then
begin
if osVerInfo.szCSDVersion[1] = 'A' then
Result := wv98SE
else
Result := wv98;
end
else if (majorVersion = 4) and (minorVersion = 90) then
Result := wvME
else
Result := wvUnknown;
end;
end;
end;
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;
function PatchCodeDWORD(ACode: PDWORD; AValue: DWORD): Boolean;
var
LRestoreProtection, LIgnore: DWORD;
begin
Result := False;
if VirtualProtect(ACode, SizeOf(ACode^), PAGE_EXECUTE_READWRITE, LRestoreProtection) then
begin
Result := True;
ACode^ := AValue;
Result := VirtualProtect(ACode, SizeOf(ACode^), LRestoreProtection, LIgnore);
if not Result then
Exit;
Result := FlushInstructionCache(GetCurrentProcess, ACode, SizeOf(ACode^));
end;
end;
$ENDREGION
function GetInstanceList: TList;
begin
Result := TClassVars.ListClassVars;
end;
procedure SaveInstancesToFile;
begin
TClassVars.SaveToDisk;
end;
procedure OldNewInstance;
asm
call TObject.NewInstance;
end;
procedure OldAfterConstruction;
asm
call TObject.InitInstance;
end;
TObjectHack
type
TExecute = procedure of object;
procedure TObjectHack.CallOldFunction;
var
Routine: TMethod;
Execute: TExecute;
begin
Routine.Data := Pointer(Self);
Routine.Code := GetClassVars.OldVMTFreeInstance;
Execute := TExecute(Routine);
Execute;
end;
constructor TObjectHack.Create;
begin
end;
procedure TObjectHack.DecCounter;
var
ThreadId: Cardinal;
begin
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - Self.InstanceSize;
ThreadId := 0;
if (Self.ClassType.InheritsFrom(TThread)) then
ThreadId := TThread(Self).ThreadID;
$ENDIF
GetClassVars.BaseInstanceCount := GetClassVars.BaseInstanceCount -1;
CallOldFunction;
$IFDEF WATCHTHREADS
if ThreadId <> 0 then
begin
if SThreadMemory[ThreadId] < 0 then
SMissedMemoryFlow := SMissedMemoryFlow + SThreadMemory[ThreadId];
SThreadMemory[ThreadId] := 0;
end;
$ENDIF
end;
destructor TObjectHack.Destroy;
begin
inherited;
end;
class function TObjectHack.GetClassVars: TClassVars;
begin
Result := PClassVars(Integer(Self) + vmtAutoTable)^;
end;
function _InitializeHook(AClass: TClass; AOffset: Integer; HookAddress: Pointer): Boolean;
var
lAddress: Pointer;
lProtect: DWord;
begin
lAddress := Pointer(Integer(AClass) + AOffset);
Result := VirtualProtect(lAddress, 4, PAGE_READWRITE, @lProtect);
if not Result then
Exit;
CopyMemory(lAddress, @HookAddress, 4);
Result := VirtualProtect(lAddress, 4, lProtect, @lProtect);
end;
class procedure TObjectHack.SetClassVars(AClassVars: TClassVars);
begin
AClassVars.BaseClassName := Self.ClassName;
AClassVars.BaseInstanceSize := Self.InstanceSize;
AClassVars.OldVMTFreeInstance := PPointer(Integer(TClass(Self)) + vmtFreeInstance)^;
if Self.ClassParent <> nil then
AClassVars.BaseParentClassName := Self.ClassParent.ClassName;
PatchCodeDWORD(PDWORD(Integer(Self) + vmtAutoTable), DWORD(AClassVars));
_InitializeHook(Self, vmtFreeInstance, @TObjectHack.DecCounter);
end;
procedure RegisterClassVarsSupport(const Classes: array of TObjectHack);
var
LClass: TObjectHack;
begin
for LClass in Classes do
if LClass.GetClassVars = nil then
LClass.SetClassVars(TClassVars.Create)
else
raise Exception.CreateFmt('Class %s has automated section or duplicated registration.', [LClass.ClassName]);
end;
procedure TObjectHack.IncCounter;
begin
if GetClassVars = nil then
RegisterClassVarsSupport(Self);
GetClassVars.BaseInstanceCount := GetClassVars.BaseInstanceCount + 1;
end;
TClassVars
constructor TClassVars.Create;
begin
ListClassVars.Add(Self);
end;
class procedure TClassVars.SaveToDisk;
var
LStringList: TStringList;
i: Integer;
begin
LStringList := TStringList.Create;
try
LStringList.Add('CLASS | NUMBER OF INSTANCES');
$IFDEF TRACEINSTANCES
for i := 0 to ListClassVars.Count -1 do
if TClassVars(ListClassVars.Items[I]).BaseInstanceCount > 0 then
LStringList.Add(TClassVars(ListClassVars.Items[I]).BaseClassName + '|' + IntToStr(TClassVars(ListClassVars.Items[I]).BaseInstanceCount));
$ENDIF
$IFDEF TRACEBUFFER
for I := 0 to SIZE_OF_MAP do
if SMap[I] > 0 then
LStringList.Add(Format('Mem. Size: %d | Amount: %d', [I, SMap[I]]));
$ENDIF
LStringList.SaveToFile(ExtractFilePath(ParamStr(0)) + 'MemReport.txt');
finally
FreeAndNil(LStringList);
end;
end;
//////////////////////////////////////////////////////////////////////////////////////
/// Memory manager controller
function IsInMap(AValue: Integer): Boolean; inline;
begin
try
Result := (AValue > Integer(@SMap)) and (AValue <= Integer(@SMap[SIZE_OF_MAP]));
except
Result := False;
end;
end;
function MemorySizeOfPos(APos: Integer): Integer; inline;
begin
Result := (APos - Integer(@SMap)) div SIZE_OF_INT;
end;
function NAllocMem(Size: Cardinal): Pointer;
var
pIntValue: ^Integer;
MapSize: Integer;
ThreadId: Cardinal;
begin
if Size > SIZE_OF_MAP then
MapSize := SIZE_OF_MAP
else
MapSize := Size;
Result := SDefaultAllocMem(Size + GAP_SIZE);
pIntValue := Result;
SMap[MapSize] := SMap[MapSize] + 1;
pIntValue^ := Integer(@SMap[MapSize]);
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Size;
pIntValue := Pointer(Integer(Result) + SIZE_OF_INT);
pIntValue^ := ThreadId;
$ENDIF
Result := Pointer(Integer(Result) + GAP_SIZE);
end;
function NGetMem(Size: Integer): Pointer;
var
LPointer: Pointer;
pIntValue: ^Integer;
MapSize: Integer;
ThreadId: Cardinal;
begin
if Size > SIZE_OF_MAP then
MapSize := SIZE_OF_MAP
else
MapSize := Size;
LPointer := SDefaultGetMem(Size + GAP_SIZE);
pIntValue := LPointer;
SMap[MapSize] := SMap[MapSize] + 1;
pIntValue^ := Integer(@SMap[MapSize]);
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Size;
pIntValue := Pointer(Integer(LPointer) + SIZE_OF_INT);
pIntValue^ := ThreadId;
$ENDIF
Result := Pointer(Integer(LPointer) + GAP_SIZE);
end;
function NFreeMem(P: Pointer): Integer;
var
pIntValue: ^Integer;
LPointer: Pointer;
ThreadId: Cardinal;
LFreed: Boolean;
begin
LPointer := Pointer(Integer(P) - GAP_SIZE);
pIntValue := LPointer;
if IsInMap(pIntValue^) then
begin
$IFDEF WATCHTHREADS
ThreadId := Integer(Pointer(Integer(pIntValue) + SIZE_OF_INT)^);
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - MemorySizeOfPos(pIntValue^);
$ENDIF
Integer(Pointer(pIntValue^)^) := Integer(Pointer(pIntValue^)^) - 1;
Result := SDefaultFreeMem(LPointer);
end
else
Result := SDefaultFreeMem(P);
end;
function NReallocMem(P: Pointer; Size: Integer): Pointer;
var
pIntValue: ^Integer;
LPointer: Pointer;
LSizeMap: Integer;
ThreadId: Cardinal;
begin
LPointer := Pointer(Integer(P) - GAP_SIZE);
pIntValue := LPointer;
if not IsInMap(pIntValue^) then
begin
Result := SDefaultReallocMem(P, Size);
Exit;
end;
if Size > SIZE_OF_MAP then
LSizeMap := SIZE_OF_MAP
else
LSizeMap := Size;
//Uma vez com o valor setado, não pode remover o setor
Integer(Pointer(pIntValue^)^) := Integer(Pointer(pIntValue^)^) - 1;
$IFDEF WATCHTHREADS
ThreadId := Integer(Pointer(Integer(pIntValue) + SIZE_OF_INT)^);
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - MemorySizeOfPos(pIntValue^) + Size;
$ENDIF
Result := SDefaultReallocMem(LPointer, Size + GAP_SIZE);
SMap[LSizeMap] := SMap[LSizeMap] + 1;
pIntValue := Result;
pIntValue^ := Integer(@SMap[LSizeMap]);
Result := Pointer(Integer(Result) + GAP_SIZE);
end;
procedure TObjectHack.NFreeInstance;
var
ThreadId: Cardinal;
begin
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - Self.InstanceSize;
$ENDIF
CleanupInstance;
SDefaultFreeMem(Self);
end;
class function TObjectHack.NNewInstance: TObject;
var
ThreadId: Cardinal;
begin
Result := InitInstance(SDefaultGetMem(Self.InstanceSize));
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Self.InstanceSize;
$ENDIF
end;
class function TObjectHack.NNewInstanceTrace: TObject;
var
ThreadId: Cardinal;
begin
try
Result := InitInstance(SDefaultGetMem(Self.InstanceSize));
if (Result.ClassType = TClassVars) or (Result is EExternal) then
Exit;
TObjectHack(Result).IncCounter;
$IFDEF WATCHTHREADS
ThreadId := GetCurrentThreadId;
SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Self.InstanceSize;
$ENDIF
except
raise Exception.Create(Result.ClassName);
end;
end;
procedure InitializeArray;
var
I: Integer;
begin
for I := 0 to SIZE_OF_MAP do
SMap[I] := 0;
end;
type
PLocalTest = ^LocalTest;
LocalTest = record
Size: integer;
Size2: string;
end;
procedure ApplyMemoryManager;
var
LMemoryManager: TMemoryManagerEx;
begin
GetMemoryManager(LMemoryManager);
SDefaultGetMem := LMemoryManager.GetMem;
$IFNDEF TRACEBUFFER
Exit;
$ENDIF
LMemoryManager.GetMem := NGetMem;
SDefaultFreeMem := LMemoryManager.FreeMem;
LMemoryManager.FreeMem := NFreeMem;
SDefaultReallocMem := LMemoryManager.ReallocMem;
LMemoryManager.ReallocMem := NReallocMem;
SDefaultAllocMem := LMemoryManager.AllocMem;
LMemoryManager.AllocMem := NAllocMem;
SetMemoryManager(LMemoryManager);
end;
procedure TestRecord;
var
LTest: PLocalTest;
begin
LTest := AllocMem(1);
Dispose(LTest);
LTest := AllocMem(SIZE_OF_MAP + 1);
Dispose(LTest);
New(LTest);
ReallocMem(LTest, SIZE_OF_MAP +1);
Dispose(LTest);
end;
procedure TesteObject;
var
LTestObject: TObject;
begin
LTestObject := TObject.Create;
LTestObject.Free;
end;
TNamedBuffer
constructor TNamedBufferList.Create;
begin
inherited Create;
Sorted := True;
end;
function GetBufferName(ASize: integer): string;
begin
Result := SNamedBufferList.GetBufferName(ASize);
end;
procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);
begin
SNamedBufferList.RegisterNamedBuffer(ABufferName, ASize);
end;
function TNamedBufferList.GetBufferName(ASize: integer): string;
var
LIndex: Integer;
begin
Result := 'Unknow';
LIndex := IndexOf(ASize);
if LIndex = -1 then
Exit;
Result := TNamedBuffer(Objects[LIndex]).Names;
end;
procedure TNamedBufferList.RegisterNamedBuffer(ABufferName: string; ASize: integer);
var
LIndex: Integer;
LNamedBuffer: TNamedBuffer;
begin
LIndex := IndexOf(ASize);
if LIndex = -1 then
begin
LNamedBuffer := TNamedBuffer.Create;
LNamedBuffer.Names := 'Possible types: ' + ABufferName;
Self.AddObject(ASize, LNamedBuffer);
end
else
TNamedBuffer(Objects[LIndex]).Names := TNamedBuffer(Objects[LIndex]).Names + ' | ' + ABufferName;
end;
procedure InitializeAnalyser;
var
LCan: Boolean;
begin
SIsMemoryWatcherActive := False;
SNamedBufferList := TNamedBufferList.Create;
case GetWinVersion of
wv98, wvXP, wvVista, wv7: LCan := True;
else LCan := False;
end;
if not LCan then
Exit;
$IFDEF TRACEINSTANCES
TClassVars.ListClassVars := TList.Create;
$ENDIF
$IFDEF TRACEBUFFER
InitializeArray;
$ENDIF
ApplyMemoryManager;
/// Buffer wrapper
$IFDEF TRACEBUFFER
TestRecord;
$IFNDEF TRACEINSTANCES
AddressPatch(GetMethodAddress(@OldNewInstance), @TObjectHack.NNewInstance);
$ENDIF
$ENDIF
///Class wrapper
$IFDEF TRACEINSTANCES
AddressPatch(GetMethodAddress(@OldNewInstance), @TObjectHack.NNewInstanceTrace);
TesteObject;
$ENDIF
SIsMemoryWatcherActive := True;
end;
TThreadDestroy
initialization
InitializeAnalyser
end.
【问题讨论】：
不使用 FastMM 泄漏检测的任何原因。或者 madExcept 的。顺便说一句，后者真的很好。正如您对 madshi 所期望的那样。 我需要一份不关闭应用程序的报告。这就是我这样做的原因。由于某种原因，FastMM 在应用程序关闭时不会生成报告。 madExcept的我没试过，我去看看。 在终止之前，您无法判断块是否泄漏。 FastMM 确实允许您在应用程序运行时检查内存使用情况。 你确定，我不能说在应用程序的和之前有什么东西是泄漏的。但是，当我们与应用程序建立密切关系时，您就会知道某些对象不应该被分配这么多，诸如此类的事情。当我定期获得应用程序状态的报告时，我可以将其放在图形中，并看到女巫对象只是增加了。因此，掌握一些关于应用程序的静态知识和知识帮助太大了。我的团队已经在使用它来查找漏洞并且已经帮助了我们很多时间。问题是我们不能用它来查找缓冲区泄漏。但是对于对象来说效果很好。 欢迎来到 Stack Overflow。我投票结束这个问题，因为过于本地化，因为据我所知，这里唯一的问题是“我的错误在哪里？”这并不是 Stack Overflow 想要解决的问题。请您自己找到错误，然后询问如何修复它。自己不知道怎么找bug，那就问怎么调试。 【参考方案1】：我没有清理 FreeMem 上的奇偶校验字节。 如果有人想看看或帮助，我会继续努力：http://rfrezinos.wordpress.com/delphi-memory-profiler/
委托人
【讨论】：
以上是关于Leak Watcher Tool - 重载内存分配的主要内容，如果未能解决你的问题，请参考以下文章