delphi中Dispose内存释放及字符串内存管理

          在最近使用Delphi开发的项目中，出现了内存泄露的问题，经排查是由于使用New申请的结构体内存用Dispose释放不完全造成的。网上会搜到如下的解释。

          delphi设计的 dispose 释放内存时，只是标记这部分内存可以再用来被 new 等函数分配，并不是把从系统申请到的内存归还给操作系统，只在程序结束时，才全部释放给操作系统。

        其实，上面的解释是不正确的。用New申请的结构体内存，在使用Dispose释放时，会将结构体所占用的内存立即释放掉。但如果结构体中使用了Delphi动态内存管理的数据类型（如字符串String，动态数组等），如果Dispose使用不正确（下文会做详细说明），会造成这些Delphi动态管理的内存不能释放，最终导致了内存泄露。为了验证该问题编写了下面的代码。

unit untMain;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, PsAPI, StdCtrls, TLHelp32;


type
  PMyRec = ^TMyRec;

  TMyRec = record
    IntMember: Integer;
    FloatMember: Double;
    StrMember: string;
  end;


  PStrRec = ^StrRec;
  StrRec = packed record
    refCnt: Longint;
    length: Longint;
  end;


  TMyList = class(TList)
  private
    FAdvanced: boolean;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  end;


  TForm1 = class(TForm)
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    mmoLog: TMemo;
    btn7: TButton;
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
  private
    { Private declarations }
    FLst: TMyList;
    procedure AddLog(Content: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  GVarS1, GVarS2: string;

implementation


function GetProcessMemUse(PID: Cardinal): Cardinal;
var pmc: PPROCESS_MEMORY_COUNTERS; //uses psApi
    ProcHandle: HWND;
    iSize: DWORD;
begin
  Result := 0;
  iSize := SizeOf(_PROCESS_MEMORY_COUNTERS);
  GetMem(pmc, iSize);
  try
    pmc^.cb := iSize;
    ProcHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
    if GetProcessMemoryInfo(ProcHandle, pmc, iSize) then
      Result := pmc^.WorkingSetSize;
  finally
    FreeMem(pmc);
  end;
end;
 
function GetCurrentMemUse: Cardinal;
begin
  Result := GetProcessMemUse(GetCurrentProcessId);
end;


{$R *.dfm}


procedure TForm1.btn2Click(Sender: TObject);
var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('开始申请100000个结构体内存（不分配字符串）,当前进程占用内存%.2fKB，结构体所占内存为%.2fKB !', [dMS1, SizeOf(TMyRec) * 100000 / 1024]));
  for idx := 1 to 100000 do
  begin
    New(pRec);
    pRec^.StrMember := 'hello this is record memory test application!';
    FLst.Add(pRec);
  end;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('申请100000个结构体内存（不分配字符串）结束,当前进程占用内存%.2fKB!', [dMS2]));
end;


{ TMyList }


procedure TMyList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  inherited;


  if (Action = lnDeleted) and Assigned(Ptr) then
  begin
    if FAdvanced then
      Dispose(PMyRec(Ptr))
    else
      Dispose(Ptr);
  end;
end;


procedure TForm1.btn3Click(Sender: TObject);
var dMS1, dMS2: Double;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当前进程所占内存为%.2fKB !', [dMS1]));
  FLst.FAdvanced := False;
  FLst.Clear;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当后进程所占内存为%.2fKB !', [dMS2]));
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  FLst := TMyList.Create;
end;


procedure TForm1.btn4Click(Sender: TObject);
var idx, iStr: Integer;
    pCh: PChar;
    pStr: Pointer;
    pRec: PMyRec;
    s, sStr: string;
begin
  for idx := 1 to 1000 do
  begin
    New(pRec);


    pRec^.StrMember := 'hello word kongdelin kongdelin';


    pStr := Pointer(Integer(pRec^.StrMember));


    s := '字符串地址：' + IntToStr((Integer(pStr))) + ';';
    s := s + '引用计数：' + IntToStr(PStrRec(Integer(pStr) - SizeOf(StrRec))^.refCnt)
       + ';长度：' + IntToStr(PStrRec(Integer(pStr) - SizeOf(StrRec))^.length);


    pCh := PChar(pRec^.StrMember);
    sStr := '';


    for iStr := 1 to PStrRec(Integer(pRec^.StrMember) - SizeOf(StrRec))^.length do
    begin
      sStr := sStr + pCh^;
      Inc(pCh);
    end;


    s := s + ';字符串：' + sStr;
    AddLog(s);
    FLst.Add(pRec);
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('开始申请100000个结构体内存（不分配字符串）,当前进程占用内存%.2fKB，结构体所占内存为%.2fKB !', [dMS1, SizeOf(TMyRec) * 100000 / 1024]));
  for idx := 1 to 100000 do
  begin
    New(pRec);
    FLst.Add(pRec);
  end;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('申请100000个结构体内存（不分配字符串）结束,当前进程占用内存%.2fKB!', [dMS2]));
end;


procedure TForm1.AddLog(Content: string);
begin
  mmoLog.Lines.Add(Format('[%s] %s', [FormatDateTime('yyyy-mm-dd hh:mm:ss zzz', now), Content]));
end;

procedure TForm1.btn7Click(Sender: TObject);
var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当前进程所占内存为%.2fKB !', [dMS1]));
  FLst.FAdvanced := True;
  FLst.Clear;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当后进程所占内存为%.2fKB !', [dMS2]));
end;

procedure TForm1.btn5Click(Sender: TObject);
var idx: Integer;
    pCh: PChar;
    s1, s2: string;
    sInfo: string;
    pSR: PStrRec;
    pStr: Pointer;
begin
  s1 := 'hello word!';
  s2 := 'hello word!';


  GVarS1 := 'hello word!';
  GVarS2 := 'hello word!';

  pStr := Pointer(Integer(s1));
  pSR := PStrRec(Integer(s1) - SizeOf(StrRec));
  sInfo := '';
  pCh := PChar(pStr);
  for idx := 1 to pSR^.length do
  begin
    sInfo := sInfo + pCh^;
    Inc(pCh);
  end;
  sInfo := Format('局部变量s1: 地址[%s]; 引用计数[%d]; 长度[%d]; 字符串[%s]', [IntToHex(Integer(pStr), 8), pSR^.refCnt, pSR^.length, sInfo]);
  AddLog(sInfo);

  pStr := Pointer(Integer(s2));
  pSR := PStrRec(Integer(s2) - SizeOf(StrRec));
  sInfo := '';
  pCh := PChar(pStr);
  for idx := 1 to pSR^.length do
  begin
    sInfo := sInfo + pCh^;
    Inc(pCh);
  end;
  sInfo := Format('局部变量s2: 地址[%s]; 引用计数[%d]; 长度[%d]; 字符串[%s]', [IntToHex(Integer(pStr), 8), pSR^.refCnt, pSR^.length, sInfo]);
  AddLog(sInfo);


  pStr := Pointer(Integer(GVarS1));
  pSR := PStrRec(Integer(GVarS1) - SizeOf(StrRec));
  sInfo := '';
  pCh := PChar(pStr);
  for idx := 1 to pSR^.length do
  begin
    sInfo := sInfo + pCh^;
    Inc(pCh);
  end;
  sInfo := Format('局部变量GVarS1: 地址[%s]; 引用计数[%d]; 长度[%d]; 字符串[%s]', [IntToHex(Integer(pStr), 8), pSR^.refCnt, pSR^.length, sInfo]);
  AddLog(sInfo);

  pStr := Pointer(Integer(GVarS2));
  pSR := PStrRec(Integer(GVarS2) - SizeOf(StrRec));
  sInfo := '';
  pCh := PChar(pStr);
  for idx := 1 to pSR^.length do
  begin
    sInfo := sInfo + pCh^;
    Inc(pCh);
  end;
  sInfo := Format('局部变量GVarS2: 地址[%s]; 引用计数[%d]; 长度[%d]; 字符串[%s]', [IntToHex(Integer(pStr), 8), pSR^.refCnt, pSR^.length, sInfo]);
  AddLog(sInfo);
end;


end.

       先来看看，使用Dispose能完全释放内存的情况，如上图所示，点击“申请结构体内存(无字符串)”按钮和“释放结构体”按钮，能完全释放结构体所占的内存。代码如下。

var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('开始申请100000个结构体内存（不分配字符串）,当前进程占用内存%.2fKB，结构体所占内存为%.2fKB !', [dMS1, SizeOf(TMyRec) * 100000 / 1024]));
  for idx := 1 to 100000 do
  begin
    New(pRec);
    FLst.Add(pRec);
  end;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('申请100000个结构体内存（不分配字符串）结束,当前进程占用内存%.2fKB!', [dMS2]));
end;

var dMS1, dMS2: Double;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当前进程所占内存为%.2fKB !', [dMS1]));
  FLst.FAdvanced := False;
  FLst.Clear;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当后进程所占内存为%.2fKB !', [dMS2]));
end;

      在分配结构内存中，结构体中的字符串没有赋值，是可以完全释放内存的。

      如果结构体中字符串进行了赋值（点击“申请结构体内存(含字符串)”按钮），也使用同样的释放方法则会出现内存释放不完全的问题。申请结构体内存的方法如下。

procedure TForm1.btn2Click(Sender: TObject);
var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('开始申请100000个结构体内存（不分配字符串）,当前进程占用内存%.2fKB，结构体所占内存为%.2fKB !', [dMS1, SizeOf(TMyRec) * 100000 / 1024]));
  for idx := 1 to 100000 do
  begin
    New(pRec);
    pRec^.StrMember := 'hello this is record memory test application!';
    FLst.Add(pRec);
  end;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('申请100000个结构体内存（不分配字符串）结束,当前进程占用内存%.2fKB!', [dMS2]));
end;

      运行所产生的日志如下（可以看出内存未完全释放）：

[2015-06-13 00:10:25 450] 开始申请100000个结构体内存（不分配字符串）,当前进程占用内存4960.00KB，结构体所占内存为2343.75KB !
[2015-06-13 00:10:25 575] 申请100000个结构体内存（不分配字符串）结束,当前进程占用内存13960.00KB!
[2015-06-13 00:10:38 700] 释放结构体前当前进程所占内存为13960.00KB !
[2015-06-13 00:10:38 716] 释放结构体前当后进程所占内存为13576.00KB !    

      但如果使用 “释放结构体2”按钮 来释放内存，则情况会不一样，不会出现内存释放不完全的问题，日志如下。

[2015-06-13 00:14:49 622] 开始申请100000个结构体内存（不分配字符串）,当前进程占用内存3528.00KB，结构体所占内存为2343.75KB !
[2015-06-13 00:14:49 747] 申请100000个结构体内存（不分配字符串）结束,当前进程占用内存12560.00KB!
[2015-06-13 00:15:01 341] 释放结构体前当前进程所占内存为12560.00KB !
[2015-06-13 00:15:01 388] 释放结构体前当后进程所占内存为3588.00KB !

      “释放结构体2”的代码如下。

procedure TForm1.btn7Click(Sender: TObject);
var idx: Integer;
    dMS1, dMS2: Double;
    pRec: PMyRec;
begin
  dMS1 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当前进程所占内存为%.2fKB !', [dMS1]));
  FLst.FAdvanced := True;
  FLst.Clear;
  dMS2 := GetCurrentMemUse / 1024;
  AddLog(Format('释放结构体前当后进程所占内存为%.2fKB !', [dMS2]));
end;

     两种释放方法的区别，前者在Dispose中释放的指针类型为Pointer，后者在Dispose中释放的指针类型为结构体指针。二者的区别在哪里，我们不妨看看Delphi System.pas单元中关于Dispose方法的实现。

type
  PStrRec = ^StrRec;
  StrRec = packed record
    refCnt: Longint;
    length: Longint;
  end;

procedure _Dispose(p: Pointer; typeInfo: Pointer);
begin
  _Finalize(p, typeinfo);
  FreeMem(p);
end;

procedure _Finalize(p: Pointer; typeInfo: Pointer);
begin
  _FinalizeArray(p, typeInfo, 1);
end;

procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
var
  FT: PFieldTable;
begin
  if elemCount = 0 then Exit;
  case PTypeInfo(typeInfo).Kind of
    tkLString: _LStrArrayClr(P^, elemCount);
    tkWString: _WStrArrayClr(P^, elemCount);
    tkVariant:
      while elemCount > 0 do
      begin
        _VarClr(PVarData(P)^);
        Inc(Integer(P), sizeof(Variant));
        Dec(elemCount);
      end;
    tkArray:
      begin
        FT := PFieldTable(Integer(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
        while elemCount > 0 do
        begin
          _FinalizeArray(P, FT.Fields[0].TypeInfo^, FT.Count);
          Inc(Integer(P), FT.Size);
          Dec(elemCount);
        end;
      end;
    tkRecord:
      begin
        FT := PFieldTable(Integer(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
        while elemCount > 0 do
        begin
          _FinalizeRecord(P, typeInfo);
          Inc(Integer(P), FT.Size);
          Dec(elemCount);
        end;
      end;
    tkInterface:
      while elemCount > 0 do
      begin
        _IntfClear(IInterface(P^));
        Inc(Integer(P), 4);
        Dec(elemCount);
      end;
    tkDynArray:
      while elemCount > 0 do
      begin
        _DynArrayClr(P);
        Inc(Integer(P), 4);
        Dec(elemCount);
      end;
  else
    Error(reInvalidPtr);
  end;
end;

procedure       _LStrArrayClr(var StrArray; cnt: longint);
var
  P: Pointer;
begin
  P := @StrArray;
  while cnt > 0 do
  begin
    _LStrClr(P^);
    Dec(cnt);
    Inc(Integer(P), sizeof(Pointer));
  end;
end;

procedure _LStrClr(var S);
var
  P: PStrRec;
begin
  if Pointer(S) <> nil then
  begin
    P := Pointer(Integer(S) - Sizeof(StrRec));
    Pointer(S) := nil;
    if P.refCnt > 0 then
      if InterlockedDecrement(P.refCnt) = 0 then
        FreeMem(P);
  end;
end;

         从上面的源代码中可以开出，如果在Dispose中指定了指针的具体类型，在释放结构体所占的内存的同时也会释放结构体中的字符串，动态数组等所占用的内存空间，如果没有指定指针类型，仅仅释放结构体本身所占用的内存空间。

        结论：在使用Dispose释放结构体内存时，要显示的带上指针的类型，这样才能确保内存空间能够完全释放。

示例代码下载地址：http://download.csdn.net/detail/kongguoqing791025/8801419