如果你用D7,D6之类誉岩扰的版本可枣巧以使用FastMM来监控内存的使用情况,当然以后的版本也可以用这个控件来监控内存。不过D2007以后自带了内存监视,可以通过下列语句打开内存监视,运行程序庆旦如果出现内存泄漏的情况会报告给你
ReportMemoryLeaksOnShutdown:=DebugHook<>0 //打开内存泄露报告
例如:如下的泄漏报告就是在代码中添加了上面的语句后,我建立了一个TstringList类型的控件,但是没有写释放代码,出现的提示。
可以下载一套LMDTool组薯敬件用里面的TLMDSysInfo控念配件
就能监视内存了
不用组件也有一个办法
用GetTotalPhysicalMemory和GetFreePhysicalMemory函数能获取全部内存和空闲内存
用GetTotalVitualMemory和GetFreeVitualMemory函数能获取全部虚拟内存和空闲虚拟数高慎内存
Delphi 2007 下面,在主窗口的 FormCreate 加一条ReportMemoryLeaksOnShutdown:=true
有内存族裂泄漏,会d出一个对话框.
CheckMem检测程序的内存泄漏 ,使用方法很简单,把 CHECKMem.pas 加到工程代码的第一行,重新编译程序.
再运行exe文件 . 有内存泄漏在本目录下 生成 CheckMemory.Log文件.
CheckMem.pas
unit CheckMem//Add it to the first line of project uses
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: stringValue: 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: PointerSize: 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)) + 'CheckMemory.Log')
end.
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)