localheapmm.pas

delphi开发语言下的源代码分析

{******************************************************************************/
* LocalHeapMM
* Local Heap Memory Manager
* (c) copyright 2003 by Carsten Zeumer
* last change 03/20/2003
*
*
* this code is compeltely free
* you may change, redistribute use or even sell (is some i willing to pay) it.
*
* oh.. and there is NO warranty of any kind.
*
* if you have comments or questions try this: [e-mail]
*
******************************************************************************/}

{
Abstract:
  Since Delphi offers you to substitute its default memory manager by some
  custom memory manager it come in handy to do so.
  This Memory Manager usese the Windows Local Heap Memory functions.
  In debug mode it additionally verboses all memory manipualtions and keeps
  track of allocated memory.
  The advantage of the Windows Heaps is, you can set an initial size and a
  maximum size. This can reduce memmory fragmentation and can come in handy if
  you need to simmulate low memory conditions.

Limitations:
  This Memory manager should not be used in DLLs which export data that is not
  freed by them selves (like strings!)

  A delphi memory manager only hooks into the GetMem, FreeMem and ReallocMem
  functions.
  Those functions are used by all VCL components to allocate memory for its
  private use. (including construction etc.)
   (this is why the statistics window is not using any VCL at all. it would
    end up in a endelss recursion)
  It does NOT hook into all other memory allocations! Most likely you will
  see that the actual amount of memory used by you program will differ from
  the heap size you set. this is beacuse of:
   - vcl components using different mechanism to allocate memory
      (i do not know of any examples, but you can never know!)
   - use of OLE Strings (BSTR) or Variants which are of the VT_BSTR type.
     BSTRs are allocated and freed by the SysAllocString and SysFreeString
     functions. Those functions are exported by the OLEAUT32.dll. This dll
     additionally caches strings (so it is possible that a BSTR you allocated
     and freed is still in memory!! un freed BSTR are REALY hard to track down!)
   - a call to an API that allocates memory on its own behalf
   - any use of a window class not 100% programmed in delphi (i.E. the listviews
     in debug mode allocate their own memory to hold its items and state)
   - external COM objects you use
   - if you use the MSXML components it will be even worse COmBSTR ;)


QUICK intstructions:
  * Make the LocalHeapMM the first Unit used (IMPORTANT!!)
      (go to project->view source and add it as first unit)
  * define/undefine DEBUG to enable debug mode
  * adjust the constanst to you needs:
        INITIAL_HEAP_SIZE  = Initial Size of the heap
        CONST MAX_HEAP_SIZE = maximum size of the heap. use a value -1 for
                inifite growth
        CONST CLEANUP_INTERVAL = try to do a compact memory all n-times.

}
unit LocalHeapMM;

interface

{$DEFINE DEBUG} // change to have a clean release build!

uses
{$IFDEF MSWINDOWS}
Windows,
Messages,
{$ENDIF}
SysConst;

Procedure TRACE(sMsg: String);
Function DumpMemStatus():String;

function LHGetMem(Size: Integer): Pointer;
function LHFreeMem(P: Pointer): Integer;
function LHReallocMem(P: Pointer; Size: Integer): Pointer;

implementation
uses
{$IFDEF DEBUG}
CommCtrl,
{$endif}
SysUtils;
{$R *.res}

const
  LocalHeapMemoryManager: TMemoryManager = (
  GetMem: LHGetMem;
  FreeMem: LHFreeMem;
  ReallocMem: LHReallocMem);


CONST INITIAL_HEAP_SIZE = 1024*100; // 100KB Initial Size
CONST MAX_HEAP_SIZE = INITIAL_HEAP_SIZE; // Fixed size!
CONST CLEANUP_INTERVALL=1000; // all x operatiosn compact memory

Var hHeap : THandle ;
Var OldMemMgr : TMemoryManager;
var iNextCleanUp : Integer; 
var szStatusLine : ShortString;



{$IFDEF DEBUG}

var WM_DUMP : cardinal;

  CONST IDD_MEMSTATUS = 101;

  CONST IDC_DETAILS = 1000;
  CONST IDC_MEM_OPS   = 1001;
  CONST IDC_MEM_ALLOCATIONS = 1002;
  CONST IDC_MEM_FREES = 1003;
  CONST IDC_MEM_INUSE= 1004;
  CONST IDC_MEM_OPENALLOCATIONS = 1005;
  CONST IDC_DETAILS_LIST = 1006;
  CONST IDC_TRACE_LIST = 1007;
  CONST IDC_DETAILS_REGION = 1008;



  type THeapStats = Record
        iOperations       : Integer;
        iTotalAllocations : Integer;
        iTotalFrees       : Integer;
        iOpenAllocations  : Integer;
        iMemAllocated     : Integer;
  End;
  var HeapStats : THeapStats;
  var hStatusWin : THANDLE;

  function memStatDlgProc(hWnd : THANDLE; uMessage : Longword ; wParam : Word; lParam : Longint):Longint; stdcall;
  var bShowDetails : Longint;
      hListView    : THandle;
      hTraceView    : THandle;
      hRegionView    : THandle;
      column       :  TLVColumn;
      item         :  TLVItem;
      heapEntry    : TProcessHeapEntry;
      localString  : ShortString;
      i : Cardinal ;
      c : char;
      function getObjectData(p : pointer): String;
      var       dummy : TObject;
        pSelf : Pointer;
      Begin
        dummy := TObject(heapEntry.lpData);
        pSelf := PPointer(Integer(dummy) - vmtSelfPtr)^;

        //                    if (heapEntry.cbData >  vmtSelfPtr
        Try
           localString :=  PShortString(PPointer(Integer(pSelf) + vmtClassName)^)^;
            item.pszText:=pchar(Integer(Pointer(@localString))+1);
        Except

        End;
        result:='';
      End;
  Begin
        result:=0;
        if (uMessage = WM_INITDIALOG) then
        Begin
          bShowDetails:=0;
          SetWindowPos(hWnd,HWND_TOPMOST,0,0,632,160,SWP_NOMOVE + SWP_SHOWWINDOW);
// debug debug ;)
//          bShowDetails:=1;
//          SetWindowPos(hWnd,HWND_TOPMOST,0,0,500,600,SWP_NOMOVE + SWP_SHOWWINDOW);
// /debug
          // init the ListView...
          hListView:=GetDlgItem(hWnd, IDC_DETAILS_LIST);
          column.mask:=LVCF_TEXT + LVCF_WIDTH + LVCF_FMT;
          column.fmt := LVCFMT_RIGHT;
          column.cx:=50;
          column.pszText:='Region';
          ListView_InsertColumn(hListView, 0,column);
          column.cx:=70;
          column.pszText:='Addr';
          ListView_InsertColumn(hListView, 1,column);
          column.cx:=70;
          column.pszText:='Size';
          ListView_InsertColumn(hListView, 2,column);
          column.pszText:='Overhead';
          ListView_InsertColumn(hListView, 3,column);
          column.pszText:='Occupied';
          ListView_InsertColumn(hListView, 4,column);

          column.fmt := LVCFMT_LEFT;
          column.cx:=320;
          column.pszText:='Data (paritaly)';
          ListView_InsertColumn(hListView, 5,column);

          hTraceView:=GetDlgItem(hWnd, IDC_TRACE_LIST);
          column.mask:=LVCF_TEXT + LVCF_WIDTH + LVCF_FMT;
          column.fmt := LVCFMT_RIGHT;
          column.cx:=80;
          column.pszText:='#';
          ListView_InsertColumn(hTraceView, 0,column);
          column.cx:=80;
          column.fmt := LVCFMT_LEFT;
          column.pszText:='Op';
          ListView_InsertColumn(hTraceView, 1,column);
          column.fmt := LVCFMT_RIGHT;
          column.cx:=80;
          column.pszText:='Size';
          ListView_InsertColumn(hTraceView, 2,column);
          column.fmt := LVCFMT_RIGHT;
          column.cx:=90;
          column.pszText:='MemInUse';
          ListView_InsertColumn(hTraceView, 3,column);


          hRegionView:=GetDlgItem(hWnd, IDC_DETAILS_REGION);
          column.mask:=LVCF_TEXT + LVCF_WIDTH + LVCF_FMT;
          column.cx:=50;
          column.pszText:='Region';