Leak Watcher Tool - 重载内存分配

Posted

技术标签:

【中文标题】Leak Watcher Tool - 重载内存分配【英文标题】:Leak Watcher Tool - Overloading the memory allocation 【发布时间】:2012-10-04 18:12:49 【问题描述】:

我正在开发一个工具来帮助我找到我的应用程序的内存泄漏。 该功能在我使用对象 (TOBJECT) 时运行良好,但在使用缓冲区时遇到了一些问题。 在某些情况下,我无法识别我的应用程序中出现了一些错误,这些错误似乎是对内存的一些错误访问。我在我的逻辑或代码上找不到任何可能的错误。如果有更多的德尔福经验的人可以帮助我。也许某些内存管理器的特定行为导致了问题。

多一点解释:

内存分配控制

目的:统计系统分配了多少确定大小的内存缓冲区,例如:

缓冲区大小 |分配数量 |使用的总内存

325     |       35265      |    11461125    
23      |       32         |     736
...     |       ...        |    ...

我如何控制内存分配和释放:

I created an array of integer that goes from 0 to 65365. This array will be used to keep the amount of allocs of the corresponding size.
For example, If I call GetMem for a buffer of 523, the Array[523] will increase + 1. 

The GetMem, ReallocMem, AllocMem, the problem is easy to resolve 'cause one of it's parameters is the size of the buffer. So I can use this to increase the position of the array.

The problem cames with the FreeMem, 'cause the only parameter is the pointer of the buffer. I don't know it's size.
    - I can't create a list to keep the Pointer and it's size. 'Cause there is SO much allocations, it will be so much expensive to the application keep searching/adding/removing items from this list. And this list must to be protected with critical section etc etc. So no way.

How I'm trying to solve this problem: 
    Just to remeber I created the array to keep the number off allocations. 

    Items:     0                              65365
               |................................|
    Addess:   $X                            $(65365x SizeOf(Integer))   

    When allocators methos are called, for example: GetMem(52);
    I changed the behavior of it, I will alloc the requested size (52), but I'll add here a size of an integer;
    So I will have:  

    0     4                          56 
    |.....|...........................|
       $x           

    In the plus space (0..3) I'll set the address of the corresponding space of the array. In this case the address position $array(52). And I add + (SizeOf(Integer)) to the address result of the GetMem, so it will have access just the 52 bytes that were asked for.

    When the FreeMem are called. What I do is:
        - Get the pointer asked for deallocation.
        - Decrease the pointer by the size of the integer
        - Check if the address of the current pointer is relative to the Array of control address.
        - If it is, I use the the address and decrease 1 from the Array position
        - And ask for the FreeMem

在大部分时间和系统中,它运行良好。但是,在某些时候,我真的不知道如何以及是否在系统中遇到了一些奇怪的错误。如果我停用此实现,我永远不会得到错误。

我正在注释代码以便更容易理解,但这不是硬代码,所以这里是:

其他线程:https://forums.embarcadero.com/thread.jspa?threadID=77787

unit uInstancesAnalyser;

    
    Functionality: The feature developed in this unit try to watch how the memory are being allocated by your system. The main focus of it is help to find memory leak in the most non intrusive way.
    How to Install: Put this unit as the first unit of yout project. If use use a third memory manager put this unit just after the unit of your memory manager.
    How to get it's report: It's not the final version of this unit, so the viewer was not developed. By the momento you can call the
        method SaveInstancesToFile. It'll create a text file called MemReport in the executable path.

    WARNING: If you use the pointer of the VMT destinated to vmtAutoTable, you should not use the directive TRACEINSTANCES.

    How it works:
    The feature work in two different approaches:
    1) Map the memory usage by objects
    2) Map the memory usage by buffers (Records, strings and so on)

    How are Objects tracked:
      The TObject.NewInstance was replaced by a new method (TObjectHack.NNewInstanceTrace).
      So when the creation of an object is called it's redirect to the new method. In this new method is increased the counter of the relative class and change the method in the VMT that is responsible to free the object to a new destructor method (vmtFreeInstance). This new destructor call the decrease of the counter and the old destructor.
      This way I can know how much of objects of each class are alive in the system.

      (More details about how it deep work can be found in the comments on the code)

    How are Memory Buffer Traced:
      The GetMem, FreeMem, ReallocMem, AllocMem were replaced by new method that have an special behavior to help track the buffers.

       As the memory allocation use the same method to every kind of memory request, I'm not able to create a single counter to each count of buffer. So, I calculate them base on it size. First I create a array of integer that start on 0 and goes to 65365.
      When the system ask me to give it a buffer of 65 bytes, I increase the position 65 of the array and the buffer is deallocated I call the decrease of the position of the array corresponding to buffer size. If the size requested to the buffer is bigger or equal to 65365, I'll use the position 65365 of the array.

      (More details about how it deep work can be found in the comments on the code)

    --------------------------------------------------------------------------------------
    Develop by  Rodrigo Farias Rezino
        E-mail: rodrigofrezino@gmail.com
        ***: http://***.com/users/225010/saci
         Please, any bug let me know
    

    interface
    $DEFINE TRACEBUFFER    Directive used to track buffer //Comment to inactive
    $DEFINE TRACEINSTANCES Directive used to track objects //Comment to inactive

    //$DEFINE WATCHTHREADS // It's not finished

    uses
      Classes, SyncObjs, uIntegerList;

      You can register possibles names for some Buffers Sizes, it can be useful when you are working with record. Example
        TRecordTest = record
          Field1: Integer
          Field2: string[50]

        So, you can call RegisterNamedBuffer(TRecordTest, SizeOf(TRecordTest));
        This way, in on the report of buffer/objects will be explicit what possibles named buffer can be that memory in use.
      procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);

      This function return the possible named buffers registered with that size
      function GetBufferName(ASize: integer): string;

      It's a simple output to save the report of memory usage on the disk. It'll create a file called test.txt in the executable directory
      procedure SaveInstancesToFile;

    var
      Flag to say if the memory watcher is on or off
      SIsMemoryWatcherActive: Boolean;

    implementation

    uses
       Windows, SysUtils, TypInfo;

    const
      SIZE_OF_INT = SizeOf(Integer);

      SIZE_OF_MAP = 65365;
      $IFDEF WATCHTHREADS
      GAP_SIZE = SIZE_OF_INT * 2;
      $ELSE
      GAP_SIZE = SIZE_OF_INT;
      $ENDIF

    type
      TArrayOfMap = array [0..SIZE_OF_MAP] of Integer;
      TThreadMemory = array [0..SIZE_OF_MAP] of Integer;

      This class is used to Register
      TNamedBufferList = class(TIntegerList)
      public
        constructor Create;

        function GetBufferName(ASize: integer): string;
        procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);
      end;

      PClassVars = ^TClassVars;
      TClassVars = class(TObject)
      private
        class var ListClassVars: TList;
      public
        BaseInstanceCount: Integer;
        BaseClassName: string;
        BaseParentClassName: string;
        BaseInstanceSize: Integer;
        OldVMTFreeInstance: Pointer;
        constructor Create;
        class procedure SaveToDisk;
      end;

      TNamedBuffer = class(TObject)
        Names: string;
      end;

      PJump = ^TJump;
      TJump = packed record
        OpCode: Byte;
        Distance: Pointer;
      end;

      TObjectHack = class(TObject)
      private
        FCriticalSection: TCriticalSection;
        class procedure SetClassVars(AClassVars: TClassVars); //inline;
        class function GetClassVars: TClassVars; inline;

        procedure IncCounter; inline;
        procedure DecCounter; inline;
        procedure CallOldFunction;
      public
        constructor Create;
        destructor Destroy; override;

        class function NNewInstance: TObject;
        class function NNewInstanceTrace: TObject;
        procedure NFreeInstance;
      end;

    var
      SDefaultGetMem: function(Size: Integer): Pointer;
      SDefaultFreeMem: function(P: Pointer): Integer;
      SDefaultReallocMem: function(P: Pointer; Size: Integer): Pointer;
      SDefaultAllocMem: function(Size: Cardinal): Pointer;

      SThreadMemory: TThreadMemory;
      SMap: TArrayOfMap;
      SNamedBufferList: TNamedBufferList;

      $IFDEF WATCHTHREADS
      SMissedMemoryFlow: Integer;
      $ENDIF

    $REGION 'Util'
    type
      TWinVersion = (wvUnknown, wv95, wv98, wv98SE, wvNT, wvME, wv2000, wvXP, wvVista, wv2003, wv7);

    function GetWinVersion: TWinVersion;
    var
      osVerInfo: TOSVersionInfo;
      majorVersion, minorVersion: Integer;
    begin
      Result := wvUnknown;
      osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
      if GetVersionEx(osVerInfo) then
      begin
        minorVersion := osVerInfo.dwMinorVersion;
        majorVersion := osVerInfo.dwMajorVersion;
        case osVerInfo.dwPlatformId of
          VER_PLATFORM_WIN32_NT:
          begin
            if majorVersion <= 4 then
              Result := wvNT
            else if (majorVersion = 5) and (minorVersion = 0) then
              Result := wv2000
            else if (majorVersion = 5) and (minorVersion = 1) then
              Result := wvXP
            else if (majorVersion = 5) and (minorVersion = 2) then
              Result := wv2003
            else if (majorVersion = 6) then
              Result := wvVista
            else if (majorVersion = 7) then
              Result := wv7;
          end;
          VER_PLATFORM_WIN32_WINDOWS:
          begin
            if (majorVersion = 4) and (minorVersion = 0) then
              Result := wv95
            else if (majorVersion = 4) and (minorVersion = 10) then
            begin
              if osVerInfo.szCSDVersion[1] = 'A' then
                Result := wv98SE
              else
                Result := wv98;
            end
            else if (majorVersion = 4) and (minorVersion = 90) then
              Result := wvME
            else
              Result := wvUnknown;
          end;
        end;
      end;
    end;

    function GetMethodAddress(AStub: Pointer): Pointer;
    const
      CALL_OPCODE = $E8;
    begin
      if PBYTE(AStub)^ = CALL_OPCODE then
      begin
        Inc(Integer(AStub));
        Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^);
      end
      else
        Result := nil;
    end;

    procedure AddressPatch(const ASource, ADestination: Pointer);
    const
      JMP_OPCODE = $E9;
      SIZE = SizeOf(TJump);
    var
      NewJump: PJump;
      OldProtect: Cardinal;
    begin
      if VirtualProtect(ASource, SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then
      begin
        NewJump := PJump(ASource);
        NewJump.OpCode := JMP_OPCODE;
        NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5);

        FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump));
        VirtualProtect(ASource, SIZE, OldProtect, @OldProtect);
      end;
    end;

    function PatchCodeDWORD(ACode: PDWORD; AValue: DWORD): Boolean;
    var
      LRestoreProtection, LIgnore: DWORD;
    begin
      Result := False;
      if VirtualProtect(ACode, SizeOf(ACode^), PAGE_EXECUTE_READWRITE, LRestoreProtection) then
      begin
        Result := True;
        ACode^ := AValue;
        Result := VirtualProtect(ACode, SizeOf(ACode^), LRestoreProtection, LIgnore);

        if not Result then
          Exit;

        Result := FlushInstructionCache(GetCurrentProcess, ACode, SizeOf(ACode^));
      end;
    end;

    $ENDREGION

    function GetInstanceList: TList;
    begin
      Result := TClassVars.ListClassVars;
    end;

    procedure SaveInstancesToFile;
    begin
      TClassVars.SaveToDisk;
    end;

    procedure OldNewInstance;
    asm
      call TObject.NewInstance;
    end;

    procedure OldAfterConstruction;
    asm
      call TObject.InitInstance;
    end;

     TObjectHack 
    type
      TExecute = procedure of object;

    procedure TObjectHack.CallOldFunction;
    var
      Routine: TMethod;
      Execute: TExecute;
    begin
      Routine.Data := Pointer(Self);
      Routine.Code := GetClassVars.OldVMTFreeInstance;
      Execute := TExecute(Routine);
      Execute;
    end;

    constructor TObjectHack.Create;
    begin

    end;

    procedure TObjectHack.DecCounter;
    var
      ThreadId: Cardinal;
    begin
      $IFDEF WATCHTHREADS
      ThreadId := GetCurrentThreadId;
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - Self.InstanceSize;
      ThreadId := 0;
      if (Self.ClassType.InheritsFrom(TThread)) then
        ThreadId := TThread(Self).ThreadID;
      $ENDIF

      GetClassVars.BaseInstanceCount := GetClassVars.BaseInstanceCount -1;
      CallOldFunction;

      $IFDEF WATCHTHREADS
      if ThreadId <> 0 then
      begin
        if SThreadMemory[ThreadId] < 0 then
          SMissedMemoryFlow := SMissedMemoryFlow + SThreadMemory[ThreadId];

        SThreadMemory[ThreadId] := 0;
      end;
      $ENDIF
    end;

    destructor TObjectHack.Destroy;
    begin

      inherited;
    end;

    class function TObjectHack.GetClassVars: TClassVars;
    begin
      Result := PClassVars(Integer(Self) + vmtAutoTable)^;
    end;

    function _InitializeHook(AClass: TClass; AOffset: Integer; HookAddress: Pointer): Boolean;
    var
      lAddress: Pointer;
      lProtect: DWord;
    begin
      lAddress := Pointer(Integer(AClass) + AOffset);
      Result := VirtualProtect(lAddress, 4, PAGE_READWRITE, @lProtect);
      if not Result then
        Exit;

      CopyMemory(lAddress, @HookAddress, 4);
      Result := VirtualProtect(lAddress, 4, lProtect, @lProtect);
    end;

    class procedure TObjectHack.SetClassVars(AClassVars: TClassVars);
    begin
      AClassVars.BaseClassName := Self.ClassName;
      AClassVars.BaseInstanceSize := Self.InstanceSize;
      AClassVars.OldVMTFreeInstance := PPointer(Integer(TClass(Self)) + vmtFreeInstance)^;

      if Self.ClassParent <> nil then
        AClassVars.BaseParentClassName := Self.ClassParent.ClassName;

      PatchCodeDWORD(PDWORD(Integer(Self) + vmtAutoTable), DWORD(AClassVars));
      _InitializeHook(Self, vmtFreeInstance, @TObjectHack.DecCounter);
    end;

    procedure RegisterClassVarsSupport(const Classes: array of TObjectHack);
    var
      LClass: TObjectHack;
    begin
      for LClass in Classes do
        if LClass.GetClassVars = nil then
          LClass.SetClassVars(TClassVars.Create)
        else
          raise Exception.CreateFmt('Class %s has automated section or duplicated registration.', [LClass.ClassName]);
    end;

    procedure TObjectHack.IncCounter;
    begin
      if GetClassVars = nil then
        RegisterClassVarsSupport(Self);

      GetClassVars.BaseInstanceCount := GetClassVars.BaseInstanceCount + 1;
    end;

     TClassVars 

    constructor TClassVars.Create;
    begin
      ListClassVars.Add(Self);
    end;

    class procedure TClassVars.SaveToDisk;
    var
      LStringList: TStringList;
      i: Integer;
    begin
      LStringList := TStringList.Create;
      try
        LStringList.Add('CLASS | NUMBER OF INSTANCES');
        $IFDEF TRACEINSTANCES
        for i := 0 to ListClassVars.Count -1 do
          if TClassVars(ListClassVars.Items[I]).BaseInstanceCount > 0 then
            LStringList.Add(TClassVars(ListClassVars.Items[I]).BaseClassName + '|' + IntToStr(TClassVars(ListClassVars.Items[I]).BaseInstanceCount));
        $ENDIF

        $IFDEF TRACEBUFFER
        for I := 0 to SIZE_OF_MAP do
          if SMap[I] > 0 then
            LStringList.Add(Format('Mem. Size: %d | Amount: %d', [I, SMap[I]]));
        $ENDIF

        LStringList.SaveToFile(ExtractFilePath(ParamStr(0)) + 'MemReport.txt');
      finally
        FreeAndNil(LStringList);
      end;
    end;

    //////////////////////////////////////////////////////////////////////////////////////
    ///  Memory manager controller

    function IsInMap(AValue: Integer): Boolean; inline;
    begin
      try
        Result := (AValue > Integer(@SMap)) and (AValue <= Integer(@SMap[SIZE_OF_MAP]));
      except
        Result := False;
      end;
    end;

    function MemorySizeOfPos(APos: Integer): Integer; inline;
    begin
      Result := (APos - Integer(@SMap)) div SIZE_OF_INT;
    end;

    function NAllocMem(Size: Cardinal): Pointer;
    var
      pIntValue: ^Integer;
      MapSize: Integer;
      ThreadId: Cardinal;
    begin
      if Size > SIZE_OF_MAP then
        MapSize := SIZE_OF_MAP
      else
        MapSize := Size;

      Result := SDefaultAllocMem(Size + GAP_SIZE);
      pIntValue := Result;
      SMap[MapSize] := SMap[MapSize] + 1;
      pIntValue^ := Integer(@SMap[MapSize]);

      $IFDEF WATCHTHREADS
      ThreadId := GetCurrentThreadId;
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Size;

      pIntValue := Pointer(Integer(Result) + SIZE_OF_INT);
      pIntValue^ := ThreadId;
      $ENDIF

      Result := Pointer(Integer(Result) + GAP_SIZE);
    end;

    function NGetMem(Size: Integer): Pointer;
    var
      LPointer: Pointer;
      pIntValue: ^Integer;
      MapSize: Integer;
      ThreadId: Cardinal;
    begin
      if Size > SIZE_OF_MAP then
        MapSize := SIZE_OF_MAP
      else
        MapSize := Size;

      LPointer := SDefaultGetMem(Size + GAP_SIZE);
      pIntValue := LPointer;
      SMap[MapSize] := SMap[MapSize] + 1;
      pIntValue^ := Integer(@SMap[MapSize]);

      $IFDEF WATCHTHREADS
      ThreadId := GetCurrentThreadId;
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Size;

      pIntValue := Pointer(Integer(LPointer) + SIZE_OF_INT);
      pIntValue^ := ThreadId;
      $ENDIF

      Result := Pointer(Integer(LPointer) + GAP_SIZE);
    end;

    function NFreeMem(P: Pointer): Integer;
    var
      pIntValue: ^Integer;
      LPointer: Pointer;
      ThreadId: Cardinal;
      LFreed: Boolean;
    begin
      LPointer := Pointer(Integer(P) - GAP_SIZE);
      pIntValue := LPointer;
      if IsInMap(pIntValue^) then
      begin
        $IFDEF WATCHTHREADS
        ThreadId := Integer(Pointer(Integer(pIntValue) + SIZE_OF_INT)^);
        SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - MemorySizeOfPos(pIntValue^);
        $ENDIF
        Integer(Pointer(pIntValue^)^) := Integer(Pointer(pIntValue^)^) - 1;
        Result := SDefaultFreeMem(LPointer);
      end
      else
        Result := SDefaultFreeMem(P);
    end;

    function NReallocMem(P: Pointer; Size: Integer): Pointer;
    var
      pIntValue: ^Integer;
      LPointer: Pointer;
      LSizeMap: Integer;
      ThreadId: Cardinal;
    begin
      LPointer := Pointer(Integer(P) - GAP_SIZE);
      pIntValue := LPointer;
      if not IsInMap(pIntValue^) then
      begin
        Result := SDefaultReallocMem(P, Size);
        Exit;
      end;

      if Size > SIZE_OF_MAP then
        LSizeMap := SIZE_OF_MAP
      else
        LSizeMap := Size;

      //Uma vez com o valor setado, não pode remover o setor
      Integer(Pointer(pIntValue^)^) := Integer(Pointer(pIntValue^)^) - 1;

      $IFDEF WATCHTHREADS
      ThreadId := Integer(Pointer(Integer(pIntValue) + SIZE_OF_INT)^);
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - MemorySizeOfPos(pIntValue^) + Size;
      $ENDIF

      Result := SDefaultReallocMem(LPointer, Size + GAP_SIZE);
      SMap[LSizeMap] := SMap[LSizeMap] + 1;
      pIntValue := Result;
      pIntValue^ := Integer(@SMap[LSizeMap]);
      Result := Pointer(Integer(Result) + GAP_SIZE);
    end;

    procedure TObjectHack.NFreeInstance;
    var
      ThreadId: Cardinal;
    begin
      $IFDEF WATCHTHREADS
      ThreadId := GetCurrentThreadId;
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] - Self.InstanceSize;
      $ENDIF
      CleanupInstance;
      SDefaultFreeMem(Self);
    end;

    class function TObjectHack.NNewInstance: TObject;
    var
      ThreadId: Cardinal;
    begin
      Result := InitInstance(SDefaultGetMem(Self.InstanceSize));
      $IFDEF WATCHTHREADS
      ThreadId := GetCurrentThreadId;
      SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Self.InstanceSize;
      $ENDIF
    end;

    class function TObjectHack.NNewInstanceTrace: TObject;
    var
      ThreadId: Cardinal;
    begin
      try
        Result := InitInstance(SDefaultGetMem(Self.InstanceSize));
        if (Result.ClassType = TClassVars) or (Result is EExternal) then
          Exit;

        TObjectHack(Result).IncCounter;
        $IFDEF WATCHTHREADS
        ThreadId := GetCurrentThreadId;
        SThreadMemory[ThreadId] := SThreadMemory[ThreadId] + Self.InstanceSize;
        $ENDIF
      except
        raise Exception.Create(Result.ClassName);
      end;
    end;

    procedure InitializeArray;
    var
      I: Integer;
    begin
      for I := 0 to SIZE_OF_MAP do
        SMap[I] := 0;
    end;

    type
      PLocalTest = ^LocalTest;
      LocalTest = record
        Size: integer;
        Size2: string;
      end;

    procedure ApplyMemoryManager;
    var
      LMemoryManager: TMemoryManagerEx;
    begin
      GetMemoryManager(LMemoryManager);
      SDefaultGetMem := LMemoryManager.GetMem;
      $IFNDEF TRACEBUFFER
      Exit;
      $ENDIF
      LMemoryManager.GetMem := NGetMem;

      SDefaultFreeMem := LMemoryManager.FreeMem;
      LMemoryManager.FreeMem := NFreeMem;

      SDefaultReallocMem := LMemoryManager.ReallocMem;
      LMemoryManager.ReallocMem := NReallocMem;

      SDefaultAllocMem := LMemoryManager.AllocMem;
      LMemoryManager.AllocMem := NAllocMem;

      SetMemoryManager(LMemoryManager);
    end;

    procedure TestRecord;
    var
      LTest: PLocalTest;
    begin
      LTest := AllocMem(1);
      Dispose(LTest);

      LTest := AllocMem(SIZE_OF_MAP + 1);
      Dispose(LTest);

      New(LTest);
      ReallocMem(LTest, SIZE_OF_MAP +1);
      Dispose(LTest);
    end;

    procedure TesteObject;
    var
      LTestObject: TObject;
    begin
      LTestObject := TObject.Create;
      LTestObject.Free;
    end;

     TNamedBuffer 

    constructor TNamedBufferList.Create;
    begin
      inherited Create;
      Sorted := True;
    end;

    function GetBufferName(ASize: integer): string;
    begin
      Result := SNamedBufferList.GetBufferName(ASize);
    end;

    procedure RegisterNamedBuffer(ABufferName: string; ASize: integer);
    begin
      SNamedBufferList.RegisterNamedBuffer(ABufferName, ASize);
    end;

    function TNamedBufferList.GetBufferName(ASize: integer): string;
    var
      LIndex: Integer;
    begin
      Result := 'Unknow';
      LIndex := IndexOf(ASize);
      if LIndex = -1 then
        Exit;
      Result := TNamedBuffer(Objects[LIndex]).Names;
    end;

    procedure TNamedBufferList.RegisterNamedBuffer(ABufferName: string; ASize: integer);
    var
      LIndex: Integer;
      LNamedBuffer: TNamedBuffer;
    begin
      LIndex := IndexOf(ASize);
      if LIndex = -1 then
      begin
        LNamedBuffer := TNamedBuffer.Create;
        LNamedBuffer.Names := 'Possible types: ' + ABufferName;
        Self.AddObject(ASize, LNamedBuffer);
      end
      else
        TNamedBuffer(Objects[LIndex]).Names := TNamedBuffer(Objects[LIndex]).Names + ' | ' + ABufferName;
    end;

    procedure InitializeAnalyser;
    var
      LCan: Boolean;
    begin
      SIsMemoryWatcherActive := False;
      SNamedBufferList := TNamedBufferList.Create;

      case GetWinVersion of
        wv98, wvXP, wvVista, wv7: LCan := True;
        else LCan := False;
      end;

      if not LCan then
        Exit;

      $IFDEF TRACEINSTANCES
      TClassVars.ListClassVars := TList.Create;
      $ENDIF

      $IFDEF TRACEBUFFER
      InitializeArray;
      $ENDIF

      ApplyMemoryManager;
      ///  Buffer wrapper
      $IFDEF TRACEBUFFER
      TestRecord;
        $IFNDEF TRACEINSTANCES
        AddressPatch(GetMethodAddress(@OldNewInstance), @TObjectHack.NNewInstance);
        $ENDIF
      $ENDIF

      ///Class wrapper
      $IFDEF TRACEINSTANCES
      AddressPatch(GetMethodAddress(@OldNewInstance), @TObjectHack.NNewInstanceTrace);
      TesteObject;
      $ENDIF
      SIsMemoryWatcherActive := True;
    end;


     TThreadDestroy 
    initialization
      InitializeAnalyser

    end.

【问题讨论】:

不使用 FastMM 泄漏检测的任何原因。或者 madExcept 的。顺便说一句,后者真的很好。正如您对 madshi 所期望的那样。 我需要一份不关闭应用程序的报告。这就是我这样做的原因。由于某种原因,FastMM 在应用程序关闭时不会生成报告。 madExcept的我没试过,我去看看。 在终止之前,您无法判断块是否泄漏。 FastMM 确实允许您在应用程序运行时检查内存使用情况。 你确定,我不能说在应用程序的和之前有什么东西是泄漏的。但是,当我们与应用程序建立密切关系时,您就会知道某些对象不应该被分配这么多,诸如此类的事情。当我定期获得应用程序状态的报告时,我可以将其放在图形中,并看到女巫对象只是增加了。因此,掌握一些关于应用程序的静态知识和知识帮助太大了。我的团队已经在使用它来查找漏洞并且已经帮助了我们很多时间。问题是我们不能用它来查找缓冲区泄漏。但是对于对象来说效果很好。 欢迎来到 Stack Overflow。我投票结束这个问题,因为过于本地化,因为据我所知,这里唯一的问题是“我的错误在哪里?”这并不是 Stack Overflow 想要解决的问题。请您自己找到错误,然后询问如何修复它。自己不知道怎么找bug,那就问怎么调试。 【参考方案1】:

我没有清理 FreeMem 上的奇偶校验字节。 如果有人想看看或帮助,我会继续努力:http://rfrezinos.wordpress.com/delphi-memory-profiler/

委托人

【讨论】:

以上是关于Leak Watcher Tool - 重载内存分配的主要内容,如果未能解决你的问题,请参考以下文章

内存溢出(Oom)和内存泄露(Memory leak)

内存泄漏 Instruments Leak使用

内存泄漏(memory leak)和内存溢出

内存泄漏(Memory Leak)

iOS 关于leak检测内存问题的使用

vld(Visual Leak Detector) 内存泄露检测工具