1

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

4

2 回答 2

4

您可以在 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符号会更安全。

于 2012-05-10T21:56:50.460 回答
3

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

于 2012-05-10T17:42:05.933 回答