Question

如何在Delphi 7中跟踪内存中某个类的计数，而无需在类中添加静态计数成员。用于跟踪程序性能。先谢谢你。

Answer 1

您可以在VMT类中挂钩NewInstance和FreeInstance方法：

unit ClassHook;

{no$DEFINE SINGLE_THREAD}

interface

var
  BitBtnInstanceCounter: integer;

implementation

uses Windows, Buttons;

function GetVirtualMethod(AClass: TClass; const VmtOffset: Integer): Pointer;
begin
  Result := PPointer(Integer(AClass) + VmtOffset)^;
end;

procedure SetVirtualMethod(AClass: TClass; const VmtOffset: Integer; const Method: Pointer);
var
  WrittenBytes: {$IF CompilerVersion>=23}SIZE_T{$ELSE}DWORD{$IFEND};
  PatchAddress: PPointer;
begin
  PatchAddress := Pointer(Integer(AClass) + VmtOffset);
  WriteProcessMemory(GetCurrentProcess, PatchAddress, @Method, SizeOf(Method), WrittenBytes);
end;

{$IFOPT W+}{$DEFINE WARN}{$ENDIF}{$WARNINGS OFF} // avoid compiler "Symbol 'xxx' is deprecated" warning
const
  vmtNewInstance = System.vmtNewInstance;
  vmtFreeInstance = System.vmtFreeInstance;
{$IFDEF WARN}{$WARNINGS ON}{$ENDIF}

type
  TNewInstanceFn = function(Self: TClass): TObject;
  TFreeInstanceProc = procedure(Self: TObject);

var
  OrgTBitBtn_NewInstance: TNewInstanceFn;
  OrgTBitBtn_FreeInstance: TFreeInstanceProc;

function TBitBtn_NewInstance(Self: TClass): TObject;
begin
  Result := OrgTBitBtn_NewInstance(Self);
  {$IFDEF SINGLE_THREAD}
  Inc(BitBtnInstanceCounter);
  {$ELSE}
  InterlockedIncrement(BitBtnInstanceCounter);
  {$ENDIF}
end;

procedure TBitBtn_FreeInstance(Self: TObject);
begin
  {$IFDEF SINGLE_THREAD}
  Dec(BitBtnInstanceCounter);
  {$ELSE}
  InterlockedDecrement(BitBtnInstanceCounter);
  {$ENDIF}
  OrgTBitBtn_FreeInstance(Self);
end;

procedure InstallHooks;
begin
  OrgTBitBtn_NewInstance := GetVirtualMethod(TBitBtn, vmtNewInstance);
  OrgTBitBtn_FreeInstance := GetVirtualMethod(TBitBtn, vmtFreeInstance);
  SetVirtualMethod(Buttons.TBitBtn, vmtNewInstance, @TBitBtn_NewInstance);
  SetVirtualMethod(Buttons.TBitBtn, vmtFreeInstance, @TBitBtn_FreeInstance);
end;

procedure RemoveHooks;
begin
  SetVirtualMethod(Buttons.TBitBtn, vmtNewInstance, @OrgTBitBtn_NewInstance);
  SetVirtualMethod(Buttons.TBitBtn, vmtFreeInstance, @OrgTBitBtn_FreeInstance);
end;

initialization
  InstallHooks;

finalization
  RemoveHooks;

end.

在您的计划的任何uses条款中加入此单元，现在BitBtnInstanceCounter将跟踪TBitBtn个实例的数量。

编辑：如果有多个线程可能同时创建被跟踪类的对象，则必须使用互锁访问来修改计数器变量。请注意第三方组件可以静默使用线程，因此不定义SINGLE_THREAD符号更安全。

Answer 2

没有内置的方法可以做到这一点。一些分析器（AQTime？）通过安装自定义堆管理器挂钩然后查看位于任何对象开头的类型指针来为您生成此类指标。你可以自己做，但如果这是在开发过程中进行分析，那么使用已经开发和测试的其他东西要容易得多。

如何跟踪delphi中某个类的实例数？

2 个答案: