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.