delphi中如何檢測內存泄露?高分送﹐在線等﹗急急急。UP有分﹗

Question

delphi中如何檢測內存泄露?高分送﹐在線等﹗急急急。有例子最好﹗

Answer 1

哈哈!我有分了,剛好我有這個代碼,(轉貼)Delphi中如何检测内存泄露
发信人: flier (flier), 信区: Delphi
标 题:delphi中如何检测内存泄露(null)
试试偶这个内存使用监视器:)
用法非常简单，在你的project source里把应用这个单元的那句放到最前，如
...
uses
  MemoryManager in '...pas',
  Forms,
  Main in 'Main.pas' {frmMain},
...
修改自Delphi Developer's Handbook……
代码如下……
unit MemoryManager;interfacevar
  GetMemCount: Integer = 0;
  FreeMemCount: Integer = 0;
  ReallocMemCount: Integer = 0;
var
  mmPopupMsgDlg: Boolean = True;
  mmSaveToLogFile: Boolean = True;
  mmErrLogFile: string = '';procedure SnapToFile(Filename: string);implementationuses
  Windows, SysUtils, TypInfo;
const
  MaxCount = High(Word);
var
  OldMemMgr: TMemoryManager;
  ObjList: array[0..MaxCount] of Pointer;
  FreeInList: 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 SnapToFile(Filename: string);
var
  OutFile: TextFile;
  I, CurrFree, BlockSize: Integer;
  HeapStatus: THeapStatus;
  Item: TObject;
  ptd: PTypeData;
  ppi: PPropInfo;
begin
  AssignFile(OutFile, Filename);
  try
    if FileExists(Filename) then
      Append(OutFile)
    else
      Rewrite(OutFile);
    CurrFree := FreeInList;
    HeapStatus := GetHeapStatus; { 局部堆状态 }
    with HeapStatus do
    begin
      writeln(OutFile, '--');
      writeln(OutFile, DateTimeToStr(Now));
      writeln(OutFile);
      write(OutFile, '可用地址空间 : ');
      write(OutFile, TotalAddrSpace div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '未提交部分 : ');
      write(OutFile, TotalUncommitted div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '已提交部分 : ');
      write(OutFile, TotalCommitted div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '空闲部分 : ');
      write(OutFile, TotalFree div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '已分配部分 : ');
      write(OutFile, TotalAllocated div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '地址空间载入 : ');
      write(OutFile, TotalAllocated div (TotalAddrSpace div 100));
      writeln(OutFile, '%');
      write(OutFile, '全部小空闲内存块 : ');
      write(OutFile, FreeSmall div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '全部大空闲内存块 : ');
      write(OutFile, FreeBig div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '其它未用内存块 : ');
      write(OutFile, Unused div 1024);
      writeln(OutFile, ' 千字节');
      write(OutFile, '内存管理器消耗 : ');
      write(OutFile, Overhead div 1024);
      writeln(OutFile, ' 千字节');
    end;
    writeln(OutFile);
    write(OutFile, '内存对象数目 : ');
    writeln(OutFile, CurrFree);
    for I := 0 to CurrFree - 1 do
    begin
      write(OutFile, I: 4);
      write(OutFile, ') ');
      write(OutFile, IntToHex(Cardinal(ObjList[I]), 16));
      write(OutFile, ' - ');
      BlockSize := PDWORD(DWORD(ObjList[I]) - 4)^;
      write(OutFile, BlockSize: 4);
      write(OutFile, '($' + IntToHex(BlockSize, 4) + ')字节');
      write(OutFile, ' - ');
      try
        Item := TObject(ObjList[I]);
// code not reliable
{ write (OutFile, Item.ClassName);
write (OutFile, ' (');
write (OutFile, IntToStr (Item.InstanceSize));
write (OutFile, ' bytes)');}
// type info technique
        if PTypeInfo(Item.ClassInfo).Kind <> tkClass then
          write(OutFile, '不是对象')
        else
        begin
          ptd := GetTypeData(PTypeInfo(Item.ClassInfo));
// name, 如果是TComponent
          ppi := GetPropInfo(PTypeInfo(Item.ClassInfo), 'Name');
          if ppi <> nil then
          begin
            write(OutFile, GetStrProp(Item, ppi));
            write(OutFile, ' : ');
          end
          else
            write(OutFile, '(未命名): ');
          write(OutFile, PTypeInfo(Item.ClassInfo).Name);
          write(OutFile, ' (');
          write(OutFile, ptd.ClassType.InstanceSize);
          write(OutFile, ' 字节) - In ');
          write(OutFile, ptd.UnitName);
          write(OutFile, '.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
  begin
    if mmPopupMsgDlg then
      MessageBox(0, PChar(Format('出现%d处内存漏洞: ',
        [GetMemCount - FreeMemCount])), '内存管理监视器', mb_ok);
    if mmErrLogFile = '' then
      mmErrLogFile := ExtractFileDir(ParamStr(0)) + '\Memory.Log';
    if mmSaveToLogFile then
      SnapToFile(mmErrLogFile);
  end;
end.
　

Answer 2

謝謝henry2003(阿波) ﹐馬上結貼。