Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Is there any way to get the class name of an old style (Borland Pascal) object instance in Delphi 7?

Tags:

delphi

rtti

I have a lot of descendant of my class:

PMyAncestor =^TMyAncestor;
TMyAncestor = object
  public
    constructor init;
    destructor done; virtual;
    // There are virtual methods as well
end;

PMyDescendant1 =^TMyDescendant1;
TMyDescendant1 = object ( TMyAncestor )
end;

PMyDescendant2 =^TMyDescendant2;
TMyDescendant2 = object ( TMyAncestor )
end;

PMyDescendant3 =^TMyDescendant3;
TMyDescendant3 = object ( TMyDescendant2 )
end;

procedure foo;
var
  pMA1, pMA2, pMA3, pMA4 : PMyAncestor;
  s : string;
begin
  pMA1 := new( PMyAncestor, init );
  pMA2 := new( PMyDescendant1, init );
  pMA3 := new( PMyDescendant2, init );
  pMA4 := new( PMyDescendant3, init );
  try
    s := some_magic( pMA1 ); // s := "TMyAncestor"
    s := some_magic( pMA2 ); // s := "TMyDescendant1"
    s := some_magic( pMA3 ); // s := "TMyDescendant2"
    s := some_magic( pMA4 ); // s := "TMyDescendant3"
  finally
    dispose( pMA4, done );
    dispose( pMA3, done );
    dispose( pMA2, done );
    dispose( pMA1, done );
  end;
end;

Is there any way to get the class name of its descendant instances? I don't want to create a virtual method for this reason (there are thousands of descendants). I know there is the typeOf(T) operator. But what is its return type? OK. Pointer. But what can I cast it for? The cast to PTypeInfo seems to be wrong.

like image 765
User007 Avatar asked Sep 06 '18 09:09

User007


2 Answers

When I compile this code, and search for the names of your classes in the compiled executable, they are not found.

From this I conclude that what you are trying to do is not possible.

like image 114
David Heffernan Avatar answered Nov 15 '22 04:11

David Heffernan


It is not possible to catch the old style object type names.

Using TypeOf(), it is possible to test if the object is equal to a type:

if TypeOf(pMA1^) = TypeOf(TMyAncestor) then ...

It can also be used to build a lookup-table, in order to match with the actual type name. This can be a bit tedious if there are many object types to record in such a table.


In a comment, it is said it would be used to catch memory leaks by logging the names during the base object initialization/finalization.

Here is an example that does the logging, but instead of the type names, loggs the type names addresses. It also prints the base object name and address, which can be useful to pinpoint leaks. The object addresses are numbered in order of declaration, and it should be fairly straight forward to identify the leaking object with that knowledge.

program Project121;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

Type
  PMyAncestor =^TMyAncestor;
  TMyAncestor = object
   public
    constructor init;
    destructor done; virtual;
    // There are virtual methods as well
  end;

  PMyDescendant1 =^TMyDescendant1;
  TMyDescendant1 = object ( TMyAncestor )
  end;

  PMyDescendant2 =^TMyDescendant2;
  TMyDescendant2 = object ( TMyAncestor )
  end;

  PMyDescendant3 =^TMyDescendant3;
  TMyDescendant3 = object ( TMyDescendant2 )
  end;

constructor TMyAncestor.init;
begin
{$IFDEF DEBUG}
  WriteLn( IntToHex(Integer(TypeOf(Self))),
           ' Base class - TMyAncestor:',
           IntToHex(Integer(TypeOf(TMyAncestor))));
{$ENDIF}
end;

destructor TMyAncestor.done;
begin
{$IFDEF DEBUG}
  WriteLn(IntToHex(Integer(TypeOf(Self))),' Done.');
{$ENDIF}
end;

procedure foo;
var
  pMA1, pMA2, pMA3, pMA4 : PMyAncestor;
  s : string;
begin
  pMA1 := new( PMyAncestor, init );
  pMA2 := new( PMyDescendant1, init );
  pMA3 := new( PMyDescendant2, init );
  pMA4 := new( PMyDescendant3, init );
  try
    (*
      Do something
    *)
  finally
    dispose( pMA4, done );
    dispose( pMA3, done );
    dispose( pMA2, done );
    dispose( pMA1, done );
  end;
end;

begin
  foo;
  ReadLn;
end.

Outputs:

0041AD98 Base class - TMyAncestor:0041AD98
0041ADA8 Base class - TMyAncestor:0041AD98
0041ADB8 Base class - TMyAncestor:0041AD98
0041ADC8 Base class - TMyAncestor:0041AD98
0041ADC8 Done.
0041ADB8 Done.
0041ADA8 Done.
0041AD98 Done.
like image 27
LU RD Avatar answered Nov 15 '22 04:11

LU RD