檢查DELPHI程序內存泄漏

一、使用步驟：

A)、將CheckMem.pas單元加入到工程中

B)、修改工程文件，將'CheckMem.pas'放到uses下的第一句

program Project1;

uses
   CheckMem in 'CheckMem.pas',
   Forms,
   Unit1 in 'Unit1.pas' {Form1} ;//其他單元文件
{$R *.RES}

begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
end.

C)、正常的編譯、運行應用程序

D)、退出應用程序後，將在應用程序目錄下生成報告（如果有漏洞的話，如果沒有則不生成）。
信陽市 衡陽市 玉樹藏族自治州 海西蒙古族藏族自治州 其它地區 三門峽 南寧市 遼陽市 白銀市 阜新市 酒泉地區 張掖地區 台州市 慶陽地區 錦州市 果洛藏族自治州 保定市 青島市 阿克蘇地區 延慶縣 伊犁地區 延安市 漳州市 樂東黎族自治縣 淮北市 南陽市
二、報告解讀：

報告的內容：

===== Project1.exe,2004-6-11 15:36:55 =====

      可用地址空間 : 1024 KB(1048576 Byte)
        未提交部分 : 1008 KB(1032192 Byte)
        已提交部分 : 16 KB(16384 Byte)
          空閒部分 : 13 KB(14020 Byte)
        已分配部分 : 1 KB(2024 Byte)
全部小空閒內存塊 : 0 KB(232 Byte)
全部大空閒內存塊 : 11 KB(11864 Byte)
    其它未用內存塊 : 1 KB(1924 Byte)
    內存管理器消耗 : 0 KB(340 Byte)
      地址空間載入 : 0%

當前出現 3 處內存漏洞 :
    0) 0000000000F33798 -    19($0013)字節 - 不是對象
    1) 0000000000F337A8 -    18($0012)字節 - 不是對象
    2) 0000000000F337B8 -    18($0012)字節 - 不是對象

解讀如下：

當前出現 3 處內存漏洞 :（有三個內存塊分配了，但未釋放。注意這裏不是指對象變量或指針變量的地址，是對象的內存區域或指針指向的內存地址）

序號　未釋放內存的地址　　內存大小　　　　是否是對象？如果是列出對象的Name及class並指出對象實現的單元文件名

0) 0000000000F33798 -    19($0013)字節 - 不是對象

三、測試例子：

測試用的代碼：

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls;

type
   TForm1 = class(TForm)
     Button1: TButton;
     Button2: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
     aa:TstringList;
     bb:tbutton;
   end;

var
   Form1: TForm1;
   def:pointer;
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin
    aa:=TstringList.Create;
    bb:=Tbutton.Create(nil);
    aa.Add('abcdefdafasdfasdfasdfasdf');
    application.MessageBox(pchar(aa.Strings[0]),'asdf',MB_OK);
//    aa.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   p:Pointer;
begin
    GetMem(def,10);
    p:=def;
    fillchar(p,10,$65);
    application.MessageBox (def,'aaa',MB_OK);
//    freemem(def,10);
end;

end.

我們先點擊button1,然後退出。出現的報告如下：

當前出現 10 處內存漏洞 :
    0) 0000000000F3109C -    67($0043)字節 - 不是對象
    1) 0000000000F316A4 -    39($0027)字節 - 不是對象
    2) 0000000000F33798 -    55($0037)字節 - (未命名): TStringList (48 字節) - In Classes.pas
    3) 0000000000F337CC -   518($0206)字節 -   : TButton (512 字節) - In StdCtrls.pas
    4) 0000000000F339D0 -    42($002A)字節 - MS Sans Serif : TFont (36 字節) - In Graphics.pas
    5) 0000000000F339F8 -    38($0026)字節 - (未命名): TSizeConstraints (32 字節) - In Controls.pas
    6) 0000000000F33A1C -    30($001E)字節 - (未命名): TBrush (24 字節) - In Graphics.pas
    7) 0000000000F33A38 -    38($0026)字節 - 不是對象
    8) 0000000000F33A5C -    38($0026)字節 - 不是對象
    9) 0000000000F33A80 -    42($002A)字節 - 不是對象

把bb:=Tbutton.Create(nil);註釋掉：//bb:=Tbutton.Create(nil);再重新編譯，然後運行，再點button1。出現的報告如下：

當前出現 3 處內存漏洞 :
    0) 0000000000F33798 -    55($0037)字節 - (未命名): TStringList (48 字節) - In Classes.pas
    1) 0000000000F337CC -    38($0026)字節 - 不是對象
    2) 0000000000F337F0 -    42($002A)字節 - 不是對象

說明了：一個對象未釋放，將引起多處內存泄漏（因爲一個對象可能包含多個子對象）

OK,我們再來測試button2(注意，這次我們不點擊button1，只點擊button2　一次)，產生的報告如下：

當前出現 1 處內存漏洞 :
    0) 0000000000F33798 -    19($0013)字節 - 不是對象

再來一次，這次點擊button2　三次：

當前出現 3 處內存漏洞 :
    0) 0000000000F33798 -    19($0013)字節 - 不是對象
    1) 0000000000F337A8 -    18($0012)字節 - 不是對象
    2) 0000000000F337B8 -    18($0012)字節 - 不是對象

這說明：對於每一個未釋放的內存，CheckMem都將記錄下來！再注意上面的未釋放內存的地址是緊挨着的，因此如果看到這樣的報告，可以猜想爲一變量，多次分配，但未釋放！

四、內存泄漏測試及修復的技巧：（翻譯自MemProof幫助的部分內容，翻譯得不好，請大家來信指導）

The following are a couple of tips that can be usefull when fixing leaks   in an application :

下面的這些技巧對於修復應用程序的內存泄漏非常有用：

* First just launch the app and then close it. If even this action generates leaks, fix those leaks first. Only after the main leaks are fixed, you should go into specific functionality areas of the application.

*首先，運行應用程序然後馬上退出。如果這樣操作也產生內存泄漏，先修復這些漏洞。只有先修復這些主要的泄漏，你才能進行特定功能的測試。

* In your Delphi/C++Builder project options, remove as much forms as possible from the Auto-Create option. Create your forms dynamically.

*在你的delphi/C++Builder工程選項中，儘可能地不要使用自動創建窗體，你需要時再動態創建。


* 注意在循環中創建或分配的內存的代碼。如果它們未釋放，可能引起大量的內存泄漏。

* Go for the biggest classes first - if you see a TMyFom <class> leaking, try to fix this one first instead of going after a tiny TFont class. Since a Form will usually contain a lot of other classes, with one shot you will have fixed a lot of contained leaks.

*先修復大的類，比如你看到TMyFom 類有泄漏，先解決它的問題，然後再解決像TFont 這樣的小類。一個form類經常包含多個子類。修復一個form的未釋放問題，你將解決大量該form包含的子對象未釋的問題。

* Go for the easy fixes first. Some leaks fixes are very easy and obvious - if you fix the easy ones first, you will keep them out of your way.

*首先修復容易修復的漏洞。一些泄漏是非常容易被發現的，如果你先修復他們，你就不用老想着他們了。



附：CheckMem.pas單元

unit CheckMem; file://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: 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)) + '/CheckMemory.Log');
end.  
  克拉瑪依市 恩施土家族苗族自治州 南寧地區 開封市 景德鎮 鷹潭市 新餘市 迪慶藏族自治州 湖州市 大渡口 撫州市 宜春市 興安盟 其它地區 其它地區 其它地區 黔南布依族苗族自治州 昭通地區 許昌市 其它地區 烏魯木齊市 鹽城市 文山壯族苗族自治州 樂山市 南川市 和田地區 吐魯番地區 哈密地區 攀枝花市 博爾塔拉蒙古自治州 昌吉回族自治州 巴音郭楞蒙古自治州 伊犁哈薩克自治州 普陀區 塔城地區 牡丹江市