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

Question

How can I track the count of a certain class in memory in Delphi 7, without adding a static counting member in the class. For the purpose of tracking the program performance. Thank you in advanced.

Answer 1

You can hook the NewInstance and FreeInstance methods in the class VMT:

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.

Include this unit in any uses clause of your program and now the BitBtnInstanceCounter will track the count of TBitBtn instances.

Edit: if it is possible that several threads simultaneously create objects of the tracked class, it is necessary to use interlocked access to modify the counter variable. Beware that third-party components could silently use threads, so it's safer to not define the SINGLE_THREAD symbol.

Answer 2

There's no built-in way to do that. Some profilers (AQTime?) generate such metrics for you by installing a custom heap manager hook and then by looking at the type pointer that sits at the beginning of any object. You can do this yourself but if this is for profiling during development it's a lot easier to just use what's already been developed and tested by others.