單元記憶體管理器；
介面
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('未提交部分 : ', TotalUncommited);
Output('已提交部分 : ', TotalComfilled);
Output('休閒部分:', TotalFree);
Output('已分配部分 : ', TotalAlulated);
Output('全部小休閒記憶體區塊:', FreeSmall);
Output('全部大空閒記憶體區塊:', FreeBig);
Output('其他未使用記憶體區塊: ', Unused);
Output('記憶體管理器消耗:', Overhead);
Writeln(OutFile, '位址空間載入:':FIELD_WIDTH, TotalAlulated 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');
結尾。