DELPHI实现的内存管理器
来源:互联网 发布:灵界室友网络剧第一集 编辑:程序博客网 时间:2024/05/17 05:16
unit unitMemoryManager;
interface
procedure SnapCurrMemStatToFile(Filename: string);
implementation
uses
Windows, SysUtils, TypInfo;
const
MaxCount = High(Word);
var
OldMemMgr: TMemoryManager;
ObjList: array[0..MaxCount] of Pointer;
FreeInList: Integer = 0;
GetMemCount: Integer = 0;
FreeMemCount: Integer = 0;
ReallocMemCount: Integer = 0;
procedure AddToList(P: Pointer);
begin
if FreeInList > High(ObjList) then
begin
MessageBox(0, '内存管理监视器指针列表溢出,请增大列表项数!', '内存管理监视器', mb_ok);
Exit;
end;
ObjList[FreeInList] := P;
Inc(FreeInList);
end;
procedure RemoveFromList(P: Pointer);
var
I: Integer;
begin
for I := 0 to FreeInList - 1 do
if ObjList[I] = P then
begin
Dec(FreeInList);
Move(ObjList[I + 1], ObjList[I], (FreeInList - I) * SizeOf(Pointer));
Exit;
end;
end;
procedure SnapCurrMemStatToFile(Filename: string);
const
FIELD_WIDTH = 20;
var
OutFile: TextFile;
I, CurrFree, BlockSize: Integer;
HeapStatus: THeapStatus;
Item: TObject;
ptd: PTypeData;
ppi: PPropInfo;
procedure Output(Text: string; Value: integer);
begin
Writeln(OutFile, Text: FIELD_WIDTH, Value div 1024, ' KB(', Value, ' Byte)');
end;
begin
AssignFile(OutFile, Filename);
try
if FileExists(Filename) then
begin
Append(OutFile);
Writeln(OutFile);
end
else
Rewrite(OutFile);
CurrFree := FreeInList;
HeapStatus := GetHeapStatus; { 局部堆状态 }
with HeapStatus do
begin
Writeln(OutFile, '===== ', ExtractFileName(ParamStr(0)), ',', DateTimeToStr(Now), ' =====');
Writeln(OutFile);
Output('可用地址空间 : ', TotalAddrSpace);
Output('未提交部分 : ', TotalUncommitted);
Output('已提交部分 : ', TotalCommitted);
Output('空闲部分 : ', TotalFree);
Output('已分配部分 : ', TotalAllocated);
Output('全部小空闲内存块 : ', FreeSmall);
Output('全部大空闲内存块 : ', FreeBig);
Output('其它未用内存块 : ', Unused);
Output('内存管理器消耗 : ', Overhead);
Writeln(OutFile, '地址空间载入 : ': FIELD_WIDTH, TotalAllocated div (TotalAddrSpace div 100), '%');
end;
Writeln(OutFile);
Writeln(OutFile, Format('当前出现 %d 处内存漏洞 :', [GetMemCount - FreeMemCount]));
for I := 0 to CurrFree - 1 do
begin
Write(OutFile, I: 4, ') ', IntToHex(Cardinal(ObjList[I]), 16), ' - ');
BlockSize := PDWORD(DWORD(ObjList[I]) - 4)^;
Write(OutFile, BlockSize: 4, '($' + IntToHex(BlockSize, 4) + ')字节', ' - ');
try
Item := TObject(ObjList[I]);
if PTypeInfo(Item.ClassInfo).Kind <> tkClass then { type info technique }
write(OutFile, '不是对象')
else
begin
ptd := GetTypeData(PTypeInfo(Item.ClassInfo));
ppi := GetPropInfo(PTypeInfo(Item.ClassInfo), 'Name'); { 如果是TComponent }
if ppi <> nil then
begin
write(OutFile, GetStrProp(Item, ppi));
write(OutFile, ' : ');
end
else
write(OutFile, '(未命名): ');
Write(OutFile, Item.ClassName, ' (', ptd.ClassType.InstanceSize,
' 字节) - In ', ptd.UnitName, '.pas');
end
except
on Exception do
write(OutFile, '不是对象');
end;
writeln(OutFile);
end;
finally
CloseFile(OutFile);
end;
end;
function NewGetMem(Size: Integer): Pointer;
begin
Inc(GetMemCount);
Result := OldMemMgr.GetMem(Size);
AddToList(Result);
end;
function NewFreeMem(P: Pointer): Integer;
begin
Inc(FreeMemCount);
Result := OldMemMgr.FreeMem(P);
RemoveFromList(P);
end;
function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Inc(ReallocMemCount);
Result := OldMemMgr.ReallocMem(P, Size);
RemoveFromList(P);
AddToList(Result);
end;
const
NewMemMgr: TMemoryManager = (
GetMem: NewGetMem;
FreeMem: NewFreeMem;
ReallocMem: NewReallocMem);
initialization
GetMemoryManager(OldMemMgr);
SetMemoryManager(NewMemMgr);
finalization
SetMemoryManager(OldMemMgr);
if (GetMemCount - FreeMemCount) <> 0 then
SnapCurrMemStatToFile(ExtractFileDir(ParamStr(0)) + '/Memory.Log');
end.
- DELPHI实现的内存管理器
- C实现的内存chunk管理器
- 一种内存管理器的实现方法
- DELPHI内存详解(3)-DELPHI的内存实现
- 简单的Delphi对象管理器
- 文件系统、缓存管理器、内存管理器的关系
- 文件系统、缓存管理器、内存管理器的关系
- Delphi实现模拟Windows任务管理器CPU使用率的动态折线图
- android的低内存管理器
- Android 简单的内存管理器
- 内存管理器(十三)kernel内存管理---slab的设计与实现1
- 设备管理器的实现
- 软件管理器的实现
- URL管理器的实现
- Delphi如何实现内存共享
- delphi 实现两个exe文件共享内存映像的代码
- delphi 实现两个exe文件共享内存映像的代码
- 内存管理器
- 有关Gridview中统计数据的问题
- SQL 查詢Table表的結構
- THE FIRST DIARY IN THIS BLOG
- 【转】解决在安装EVC4.0+sp4时提示“virtual PC/Windows CE Emulator会造成windows不稳定,windows使这些驱动程序无法加载”的问题
- 期待大部分中国人都是精神病的日子
- DELPHI实现的内存管理器
- 《大象-Thinking in UML》读者专用反馈、答疑、讨论贴
- JavaScript 拖放效果
- 微软将 jQuery IntelliSense整合到Visual Studio
- 报表功能实现
- VC EXCEL 新建文件
- THE FIRST DIARY IN THIS BLOG
- 代码统计工具 source code count ソース規模計算ツール
- dbgrid的重画功能