单元内存管理器；
界面
PROcedure SnapCurrMemStatToFile(文件名：字符串);
执行
用途
Windows、SysUtils、TypInfo；
常量
最大计数 = 高（字）；
变量
OldMemMgr：TMemoryManager；
ObjList：指针的数组[0..MaxCount]；
FreeInList：整数= 0；
GetMemCount: 整数 = 0;
FreeMemCount: 整数 = 0;
ReallocMemCount: 整数 = 0;
过程 AddToList(P: 指针);
开始
如果 FreeInList > High(ObjList) 那么
开始
MessageBox(0, '内存管理不够指针列表溢出，请增加列表项数！', '内存管理不够', mb_ok);
出口;
结尾;
ObjList[FreeInList] := P;
公司（自由列表）；
结尾;
过程RemoveFromList(P: 指针);
变量
I：整数；
开始
对于 I := 0 到 FreeInList - 1 做
如果 ObjList[I] = P 则
开始
Dec(FreeInList);
Move(ObjList[I + 1], ObjList[I], (FreeInList - I) * SizeOf(指针));
出口;
结尾;
结尾;
过程 SnapCurrMemStatToFile(文件名：字符串);
常量
字段宽度=20；
变量
输出文件：文本文件；
I、CurrFree、BlockSize：整数；
堆状态：THeapStatus；
项目：TObject；
ptd：PTypeData；
ppi：PPropInfo；
过程输出（文本：字符串；值：整数）；
开始
Writeln(OutFile, 文本: FIELD_WIDTH, 值 div 1024, ' KB(', 值, ' 字节)');
结尾;
开始
分配文件（输出文件，文件名）；
尝试
如果文件存在（文件名）那么
开始
追加（输出文件）；
Writeln(输出文件);
结尾
别的
重写（输出文件）；
CurrFree := FreeInList;
堆状态 := GetHeapStatus; { 局部堆状态 }
使用 HeapStatus 执行以下操作
开始
Writeln(OutFile, '===== ', ExtractFileName(ParamStr(0)), ',', DateTimeToStr(Now), ' =====');
Writeln(输出文件);
Output('可用地址空间:', TotalAddrSpace);
Output('未提交部分 : ', TotalUncomfilled);
Output('已提交部分 : ', TotalComfilled);
Output('休闲部分:', TotalFree);
Output('已分配部分 : ', TotalAlulated);
Output('全部小休闲内存块:', FreeSmall);
Output('全部大空闲内存块:', FreeBig);
Output('其他未用内存块:', Unused);
Output('内存管理器消耗:', Overhead);
Writeln(OutFile, '地址空间加载:':FIELD_WIDTH, TotalAlowned div (TotalAddrSpace div 100), '%');
结尾;
Writeln(输出文件);
Writeln(OutFile, Format('当前出现 %d 处内存漏洞 :', [GetMemCount - FreeMemCount]));
对于 I := 0 到 CurrFree - 1 做
开始
Write(OutFile, I: 4, ') ', IntToHex(Cardinal(ObjList[I]), 16), ' - ');
块大小 := PDWORD(DWORD(ObjList[I]) - 4)^;
Write(OutFile, BlockSize: 4, '($' + IntToHex(BlockSize, 4) + ')字节', ' - ');
尝试
项目 := TObject(ObjList[I]);
if PTypeInfo(Item.ClassInfo).Kind <> tkClass then { 类型信息技术 }
write(OutFile, '不是对象')
别的
开始
ptd := GetTypeData(PTypeInfo(Item.ClassInfo));
ppi := GetPropInfo(PTypeInfo(Item.ClassInfo), '名称'); { 如果是TComponent }
如果 ppi <> nil 那么
开始
写（OutFile，GetStrProp（项目，ppi））；
写（OutFile，'：'）；
结尾
别的
write(OutFile, '(未命名): ');
Write(OutFile, Item.ClassName, ' (', ptd.ClassType.InstanceSize,
' 字节) - In ', ptd.UnitName, '.pas');
结尾
除了
异常时做
write(OutFile, '不是对象');
结尾;
writeln(输出文件);
结尾;
最后
关闭文件（输出文件）；
结尾;
结尾;
函数 NewGetMem(Size: Integer): 指针；
开始
Inc(GetMemCount);
结果 := OldMemMgr.GetMem(Size);
添加到列表（结果）；
结尾;
函数 NewFreeMem(P: 指针): 整数;
开始
公司（FreeMemCount）；
结果 := OldMemMgr.FreeMem(P);
从列表中删除(P);
结尾;
function NewReallocMem(P: 指针; 大小: 整数): 指针;
开始
Inc(ReallocMemCount);
结果 := OldMemMgr.ReallocMem(P, 大小);
从列表中删除(P);
添加到列表（结果）；
结尾;
常量
NewMemMgr: TMemoryManager = (
GetMem：新建GetMem；
FreeMem：NewFreeMem；
ReallocMem: NewReallocMem);
初始化
GetMemoryManager(OldMemMgr);
SetMemoryManager(NewMemMgr);
定稿
SetMemoryManager(OldMemMgr);
if (GetMemCount - FreeMemCount) <> 0 那么
SnapCurrMemStatToFile(ExtractFileDir(ParamStr(0)) + '/Memory.Log');
结尾。