Unitname anhand Objektreferenz ermitteln

[shmia]

Hi, ich möchte den Namen der implementierenden Unit eines Objekts ermitteln.
Dazu habe ich folgenden Code:

Delphi-Quellcode:

uses TypInfo;

function _GetUnitName(argObject: TObject): string;
var
  ptrTypeData: PTypeData;
begin
  if (argObject.ClassInfo <> nil) then
  begin
    ptrTypeData := GetTypeData(argObject.ClassInfo);
    Result := ptrTypeData.UnitName;
  end;
end;

Wenn ich ein Objekt übergebe, dann funktioniert das auch recht schön:
ShowMessage(_GetUnitName(Button1)); // Liefert StdCtrls ABER, wenn ich das Objekt über einen Umweg ermittle, dann klappt das leider nicht mehr:

Delphi-Quellcode:

type
   ITest = interface(IUnknown)
   ['{3270CA90-8F84-411E-A262-B7AFF9B87A43}']
   function GetSelfPointer:TObject;
   end;

   TTest = class(TInterfacedObject, ITest)
   protected
     function GetSelfPointer:TObject;
   end;

procedure TForm1.Button2Click(Sender: TObject);
var
   test : ITest;
   obj : TObject;
begin
   test := TTest.Create;
   obj := test.GetSelfPointer;
   ShowMessage(_GetUnitName(obj));  // liefert nichts
   // obj.ClassInfo ist nil, warum?
end;

Hintergrund der Geschichte ist, dass ich DUnit so erweitern möchte, dass zusätzlich noch der Unitname angezeigt wird.
Das wäre für alle DUnit-Benutzer ein kleines Sahnehäubchen obendrauf.

[mkinzler]

Geht
obj := test; ?

[shmia]

Ein direkter, harter Cast klappt leider nicht:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject); 
var 
   test : ITest; 
   obj : TObject; 
begin 
   test := TTest.Create; 
   obj := TObject(test); 
   ShowMessage(_GetUnitName(obj));  // endet leider in einer Zugriffsverletzung

[mkinzler]

Ein cast ist auch unnötig, da jedes Objejt ein TObject ist; sollte aber trotzdem funktionieren.
Hier scheint ompiler magic dazwischen zu funken

[shmia]

Zitat von mkinzler:

Ein cast ist auch unnötig, da jedes Objejt ein TObject ist

Die Variable "test" ist ein Interface, das ist ja gerade das Problem.
Anscheinend haben Interface und Objekt verschiedene VMTs (Virtual Method Table).
Bei einem Interface geht ClassInfo also der Eintrag vmtTypeInfo irgendwie verloren.

[himitsu]

Delphi-Quellcode:

ITest = interface(IUnknown)
  ['{3270CA90-8F84-411E-A262-B7AFF9B87A43}']
  function GetUnitName: WideString;
  end;

Wenn es direkt geht, dann ließ es doch vor Ort aus und gib nur den Namen weiter?

Es ist eh etwas wieder der Natur, wenn man von einem Interface das dahinter versteckte Objekt rausrückt.

[Hawkeye219]

Funktioniert doch

Delphi-Quellcode:

{$M+}
TTest = class(TInterfacedObject, ITest)
protected
  function GetSelfPointer:TObject;
end;
{$M-}

Gruß Hawkeye

[shmia]

Zitat von Hawkeye219:

Funktioniert doch

Vielen Dank, Du kriegt ein virtuelles von mir.

Zitat von himitsu:

Wenn es direkt geht, dann ließ es doch vor Ort aus und gib nur den Namen weiter?
Es ist eh etwas wieder der Natur, wenn man von einem Interface das dahinter versteckte Objekt rausrückt.

So habe ich es bei meinen Versuchen auch schon gemacht, aber ich wäre nie drauf gekommen, dass es an dem {$M+} Compilerschalter hängt.

Delphi-Quellcode:

  ITest = interface(IUnknown)  // aus DUnit TestFramework
    ['{89CCD557-7DE1-4814-B033-ABAFE0870EC7}']
    function GetName: string;
    function GetUnitName:string;   // Neu!
    function  CountTestCases: integer;
    function  CountEnabledTestCases: integer;
    function  Tests: IInterfaceList;

[himitsu]

Zitat von shmia:

aber ich wäre nie drauf gekommen, dass es an dem {$M+} Compilerschalter hängt.

Aus dem Grund wurde die TPersistent wohl auch damit kompiliert.