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: :thumb:

Delphi-Quellcode:

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

Delphi-Quellcode:

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:

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:

Zitat von Hawkeye219

Funktioniert doch ;-)

Vielen Dank, Du kriegt ein virtuelles :cheers: von mir.

Zitat:

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:

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. :stupid: