关于使用CheckMem.pas检查内存泄漏的问题(急在线等待)

Question

开发一个程序，使用CheckMem.pas检查内存泄漏，发现在CheckMemory.log中记录总有一处内存泄漏，内容如下：===== XXXX,2005-11-3 9:48:00 =====     可用地址空间 : 1024 KB(1048576 Byte)
       未提交部分 : 1008 KB(1032192 Byte)
       已提交部分 : 16 KB(16384 Byte)
         空闲部分 : 13 KB(14056 Byte)
       已分配部分 : 1 KB(1996 Byte)
 全部小空闲内存块 : 0 KB(232 Byte)
 全部大空闲内存块 : 13 KB(13824 Byte)
   其它未用内存块 : 0 KB(0 Byte)
   内存管理器消耗 : 0 KB(332 Byte)
     地址空间载入 : 0%当前出现 1 处内存漏洞 :
   0) 0000000000EA1F94 -  135($0087)字节 - 不是对象我跟踪这个内存的申请对象发现是FMTBcd单元，它是在初始化时申请的内存。不可理解这可是系统单元呀，到底是什么导致最后程序终止时没有释放内存呀？

Answer 1

释放时CheckMem.pas已经释放了，所以查不出来。

Answer 2

我在使用CheckMem.pas是将它放在工程文件引用单元的第一个也不行吗？

Answer 3

检查程序调用单元初始化的顺序，在调用CheckMem.pas单元前，调用了九个单元的初始化段，调用顺序如下：
1、SysInit
2、System
3、SysConst
4、Types
5、SysUtils
6、VarUtils
7、Variants
8、RTLConsts
9、TypInfo
10、CheckMem
在这其中只有SysInit,System,SysUntil,VarUtils,Variants这五个单元含有初始化段，这是Delphi最基本的单元。我无法将再将CheckMem.Pas文件的初始化提前了，除了修改System.pas文件。但是肯定是比FMTBcd单元先调用。Delphi对单元文件的释放是一个和初始化相反的逆向过程，所以kongguangming(Fly) 所说的情况是不可能的。

Answer 4

好久不来，现在的高手都到哪里去了，看来Delphi是真的没落了。

Answer 5

我也碰到同样的问题.比你惨多了....
到现在还没解决...
===== designP.exe,2005-11-04 13:49:41 =====     可用地址空间 : 2048 KB(2097152 Byte)
       未提交部分 : 1952 KB(1998848 Byte)
       已提交部分 : 96 KB(98304 Byte)
         空闲部分 : 93 KB(95424 Byte)
       已分配部分 : 2 KB(2472 Byte)
 全部小空闲内存块 : 11 KB(11656 Byte)
 全部大空闲内存块 : 81 KB(83768 Byte)
   其它未用内存块 : 0 KB(0 Byte)
   内存管理器消耗 : 0 KB(408 Byte)
     地址空间载入 : 0%当前出现 13 处内存漏洞 :
   0) 00000000013515A8 -   55($0037)字节 - 不是对象
   1) 00000000013515DC -   26($001A)字节 - 不是对象
   2) 00000000013515F4 -   26($001A)字节 - 不是对象
   3) 000000000135160C -   26($001A)字节 - 不是对象
   4) 0000000001351AB4 -   43($002B)字节 - 不是对象
   5) 0000000001351BA8 -   23($0017)字节 - 不是对象
   6) 0000000001351BBC -  134($0086)字节 - 不是对象
   7) 0000000001383B60 -   15($000F)字节 - 不是对象
   8) 0000000008115B30 -   23($0017)字节 - 不是对象
   9) 0000000001440C8C -   27($001B)字节 - 不是对象
  10) 0000000001439C04 -   23($0017)字节 - 不是对象
  11) 0000000001439C90 -   23($0017)字节 - 不是对象
  12) 00000000014189D4 -  103($0067)字节 - 不是对象

Answer 6

这是我从网上找的一段程序，我自己修改了一下，用来跟踪多线程的内存分配。只要把这个单元放在工程文件中引用单元的第一个就可了。这个文件替换了Delphi的默认的内存分配器，会对内存分配做记录。文件内容如下：
unit CheckMem;
//file:Add it to the first line of project usesinterfaceprocedure SnapCurrMemStatToFile(Filename: string);implementationuses
  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;
  OrgAllocMemSize: Integer = 0;
  CheckMemListLock: TRTLCriticalSection;procedure AddToList(P: Pointer);
begin
  EnterCriticalSection(CheckMemListLock);
  try
    if FreeInList > High(ObjList) then
    begin
      MessageBox(0, '内存管理监视器指针列表溢出，请增大列表项数！', '内存管理监视器', mb_ok);
      Exit;
    end;
    ObjList[FreeInList] := P;
    Inc(FreeInList);
  finally
    LeaveCriticalSection(CheckMemListLock);
  end;
end;procedure RemoveFromList(P: Pointer);
var
  I: Integer;
begin
  EnterCriticalSection(CheckMemListLock);
  try
    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;
  finally
    LeaveCriticalSection(CheckMemListLock);
  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
  Result := OldMemMgr.GetMem(Size);
  Inc(GetMemCount);
  //InterlockedExchangeAdd(GetMemCount, 1);
  AddToList(Result);
end;function NewFreeMem(P: Pointer): Integer;
begin
  Result := OldMemMgr.FreeMem(P);
  Inc(FreeMemCount);
  //InterlockedExchangeAdd(FreeMemCount, 1);
  RemoveFromList(P);
end;function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Result := OldMemMgr.ReallocMem(P, Size);
  Inc(ReallocMemCount);
  //InterlockedExchangeAdd(ReallocMemCount, 1);
  RemoveFromList(P);
  AddToList(Result);
end;const
  NewMemMgr: TMemoryManager = (
  GetMem: NewGetMem;
  FreeMem: NewFreeMem;
  ReallocMem: NewReallocMem);initialization
  InitializeCriticalSection(CheckMemListLock);
  GetMemoryManager(OldMemMgr);
  SetMemoryManager(NewMemMgr);finalization
  SetMemoryManager(OldMemMgr);
  DeleteCriticalSection(CheckMemListLock);
  if (GetMemCount - FreeMemCount) <> 0 then
    SnapCurrMemStatToFile(ExtractFileDir(ParamStr(0)) + '\CheckMemory.Log');end.

Answer 7

我也是碰到同样的问题。
到底不是对象是什么对象？难道就真没有高手能把不是对象明确化嘛！！！！
关注：
   [email protected]

Answer 8

这个不是对象，表示申请内存的所有者不是OOP中所指的对象，是其他的一些数据类型，如：字符串，Variant变量，接口等等。我修改了CheckMem，大家可以看看到底是什么东西没有释放。
修改如下：
unit CheckMem;
//file:Add it to the first line of project usesinterfaceprocedure SnapCurrMemStatToFile(Filename: string);implementationuses
  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;
  OrgAllocMemSize: Integer = 0;
  CheckMemListLock: TRTLCriticalSection;procedure AddToList(P: Pointer);
begin
  EnterCriticalSection(CheckMemListLock);
  try
    if FreeInList > High(ObjList) then
    begin
      MessageBox(0, '内存管理监视器指针列表溢出，请增大列表项数！', '内存管理监视器', mb_ok);
      Exit;
    end;
    ObjList[FreeInList] := P;
    Inc(FreeInList);
  finally
    LeaveCriticalSection(CheckMemListLock);
  end;
end;procedure RemoveFromList(P: Pointer);
var
  I: Integer;
begin
  EnterCriticalSection(CheckMemListLock);
  try
    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;
  finally
    LeaveCriticalSection(CheckMemListLock);
  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;
  IsClass: Boolean;  procedure Output(Text: string; Value: integer);
  begin
    Writeln(OutFile, Text: FIELD_WIDTH, Value div 1024, ' KB(', Value, ' Byte)');
  end;  procedure DisplayMemory(MemAddr: PChar);
  var
    I: Cardinal;
  begin
    for I := 1 to PDWORD(DWORD(MemAddr) - 4)^ do
    begin
      case I mod 8 of
        1: begin
            WriteLn(OutFile);
            Write(OutFile, ' $': 24, IntToHex(Ord(MemAddr[I-1]), 2), '''', MemAddr[I-1], '''');
          end;
      else
        Write(OutFile, ' $', IntToHex(Ord(MemAddr[I-1]), 2), '''', MemAddr[I-1], '''');
      end;
    end;
  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) + ')字节', ' - ');
      IsClass := False;
      try
        Item := TObject(ObjList[I]);
        if PTypeInfo(Item.ClassInfo).Kind <> tkClass then { type info technique }
          write(OutFile, '不是对象，内容如下：')
        else begin
          IsClass := True;
          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;
      if not IsClass then
        DisplayMemory(PChar(ObjList[I]));
      writeln(OutFile);
    end;
  finally
    CloseFile(OutFile);
  end;
end;function NewGetMem(Size: Integer): Pointer;
begin
  Result := OldMemMgr.GetMem(Size);
  Inc(GetMemCount);
  //InterlockedExchangeAdd(GetMemCount, 1);
  AddToList(Result);
end;function NewFreeMem(P: Pointer): Integer;
begin
  Result := OldMemMgr.FreeMem(P);
  Inc(FreeMemCount);
  //InterlockedExchangeAdd(FreeMemCount, 1);
  RemoveFromList(P);
end;function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Result := OldMemMgr.ReallocMem(P, Size);
  Inc(ReallocMemCount);
  //InterlockedExchangeAdd(ReallocMemCount, 1);
  RemoveFromList(P);
  AddToList(Result);
end;const
  NewMemMgr: TMemoryManager = (
  GetMem: NewGetMem;
  FreeMem: NewFreeMem;
  ReallocMem: NewReallocMem);initialization
  InitializeCriticalSection(CheckMemListLock);
  GetMemoryManager(OldMemMgr);
  SetMemoryManager(NewMemMgr);finalization
  SetMemoryManager(OldMemMgr);
  DeleteCriticalSection(CheckMemListLock);
  if (GetMemCount - FreeMemCount) <> 0 then
    SnapCurrMemStatToFile(ExtractFileDir(ParamStr(0)) + '\CheckMemory.Log');end.

Answer 9

这个我用起来一直觉得部好用，比起bcb里面的codeguard差太多了，到现在都没有找到好用的

Answer 10

楼上的有codeguard的源码吗？如果有能不能贴出来，我可以把它改成Delphi使用的。

Answer 11

没有把，那个是bcb自带的检查内存泄漏的工具来的

Answer 12

哈哈,什么也没做,一个空的工程引用这个单元进来后。
===== Project1.exe,2005-12-10 21:02:59 =====     可用地址空间 : 1024 KB(1048576 Byte)
       未提交部分 : 1008 KB(1032192 Byte)
       已提交部分 : 16 KB(16384 Byte)
         空闲部分 : 8 KB(9188 Byte)
       已分配部分 : 6 KB(6176 Byte)
 全部小空闲内存块 : 2 KB(2692 Byte)
 全部大空闲内存块 : 4 KB(4448 Byte)
   其它未用内存块 : 2 KB(2048 Byte)
   内存管理器消耗 : 0 KB(1020 Byte)
     地址空间载入 : 0%当前出现 -9 处内存漏洞 :
   0) 0000000000D222BC -   23($0017)字节 - 不是对象，内容如下：
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $CC'? $22'"' $D2'? $00' ' $CC'? $22'"' $D2'?
   1) 0000000000D22538 -   23($0017)字节 - 不是对象，内容如下：
                       $C0'? $1F'' $D2'? $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $16'' $00' ' $00' ' $00' ' $C0'? $1F'' $D2'?
   2) 0000000000D2254C -   22($0016)字节 - 不是对象，内容如下：
                       $C0'? $1F'' $D2'? $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $08'' $26'&' $45'E' $00' ' $08'' $26'&'
   3) 0000000000D236C0 -   23($0017)字节 - 不是对象，内容如下：
                       $48'H' $24'$' $D2'? $00' ' $0D'
' $00' ' $00' ' $00' '
                       $4D'M' $53'S' $20' ' $53'S' $61'a' $6E'n' $73's' $20' '
                       $12'' $00'6' $D2' ' $00' ' $D0'
' $00'6' $D2' '
   4) 0000000000D236E4 -  119($0077)字节 - 不是对象，内容如下：
                       $F8'? $6E'n' $42'B' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' ' $00' '
                       $56'V' $00' ' $00' ' $00' ' $01'
' $00' ' $00' '