Delphi-System-Funktion ersetzen

[himitsu]

Wenn es um die Funktion selber geht.

Das Original sieht so aus.

Delphi-Quellcode:

procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);
{$IFDEF PUREPASCAL}
// PIC:  EBX must be correct before calling QueryInterface
var
  Temp: IInterface;
begin
  if Source = nil then
    Dest := nil
  else
  begin
    Temp := nil;
    if Source.QueryInterface(IID, Temp) <> 0 then
      Error(reIntfCastError)
    else
      Dest := Temp;
  end;
end;
{$ELSE}
asm
        TEST    EDX,EDX
        JE      _IntfClear
        PUSH    EDI
        MOV     EDI, EAX   // ptr to dest
        PUSH    0
        PUSH    ESP        // ptr to temp
        PUSH    ECX        // ptr to GUID
        PUSH    EDX        // ptr to source
@@1:    MOV     EAX,[EDX]
        CALL    DWORD PTR [EAX] + VMTOFFSET IInterface.QueryInterface
        TEST    EAX,EAX
        JE      @@2
        MOV     AL,reIntfCastError
... tausende weitere Zeilen

Und wie man sieht, bekommt man dann nur die Meldung "Interface nicht unterstützt" und sonst weiß man garnicht welches und wo.

Mein Code gibt erstmal die entsprechende GUID des Interfaces aus, welches angefragt wurde.
Damit hat man schonmal einen Anhaltspunkt.

Zusätzlich wird die ganze RTTI durchsucht, ob interfacedeklarationen vorhanden sind, davon werden nun alle (idealer Weise nur Eine) rausgesucht, welche die selbe GUID besitzen.
Über die RTTI kommt man nun an den Namen der Deklaration im Quellcode.

Als Weiteres wird geschaut, ob sich in dem Interface ein Delphi-TObjekt-Nachfahre befindet.
Wenn ja, dann wird dessen Klassenname mit ausgegeben, samt dem Namen Unit. Ist es sogar ein TComponent-Nachfahre, dann eventuell auch noch dessen VCL-Name (Name-Property).
Und bei TWinControls (sichtbaren Komponenten) wird geschaut auf welcher Form/Frame dieses liegt (Parent-Property) und die Namen dieses Form/Frame werden ebenfalls angezeigt.

Ein/Zwei Unzulänglichkeiten/Fehlende Infos sind mir noch aufgefallen, aber das hat noch'n bissl Zeit.



Es gibt einfach viele Fehlermeldungen, die zwar sagen "es geht nix", aber über das was nicht geht, wird geschwiegen.

[jbg]

Wenn du jetzt die Fehlerbehandlung noch in eine andere Funktion auslagern würdest, wäre die Performance nicht ganz so stark beeinträchtigt, wenn gerade nicht der Fehlerfall eintritt. Im "begin" und "end" läuft bei deinem Code nämlich jetzt eine Menge ab.

[himitsu]

Ja, Optimierungen fehlen auch ... kommt alles noch.

[Bummi]

Also, für Debuggingzwecke ... das beruhigt mich und gefällt mir ...

[himitsu]

Jupp.

Um Probleme einfacher finden zu können, vorallem da wo Fehlermeldungen überhaupt nichts helfen, da sie nichts oder nur Schwachsinn sagen.

Genauso werden einige Exception an die richtigen Adressen verlinkt.
Der Debugger hält nach Exceptions da, wo System.ExceptAddr hinzeigt.

Bei raise Exception.Create; hält der Compiler beim RAISE, wärend beim raise Exception.Create at ADDR; der Compiler bei ADDR stehenbleibt.
Ich laß es jetzt einfach dorthinzeigen, von wo diese Procedure aufgerufen wurde, was dann hoffentlich die eigentliche Fehlerverursachende Stelle sein sollte.
Denn leider schafft Delphi es oftmals nicht, vorallem kurz nach einer Exception, den Stacktrace aufzubauen, womit man dann nicht die Fehlerstelle sehen kann.


@jbg: Besser so?

Delphi-Quellcode:

procedure ExtendedIntfError(const Source: IInterface; const IID: TGUID; CallingAddress: Pointer);
const
  ObjCastGUID: TGUID = '{CEDF24DE-80A4-447D-8C75-EB871DC121FD}';
var
  S:    string;
  GUID: TGUID;
  Obj:  TObject;
  RTyp: TRttiType;
begin
  // Fehlermeldung und GUID des angeforderten Interfaces
  S := SIntfCastError + sLineBreak + GUIDToString(IID);
  // Interface-Bezeichnung suchen
  for RTyp in TRttiContext.Create.GetTypes do
    if RTyp is TRttiInterfaceType then begin
      GUID := TRttiInterfaceType(RTyp).GUID;
      if (RTyp is TRttiInterfaceType) and (PInt64(@GUID)^ = PInt64(@IID)^) and (PInt64(@GUID.D4)^ = PInt64(@IID.D4)^) then
        S := S + ' = ' + TRttiInterfaceType(RTyp).DeclaringUnitName + '.' + TRttiInterfaceType(RTyp).Name;
    end;
  // weitere Infos, wenn sich intern ein Delphi-Objekt versteckt
  if Source.QueryInterface(ObjCastGUID, Obj) <> 0 then begin
    // Bezeichnung der Klasse
    S := S + ' < ' + Obj.UnitName + '.' + Obj.ClassName;
    if Obj is TComponent then begin
      // Komponenten-Name
      if TComponent(Obj).Name <> '' then
        S := S + '-' + TComponent(Obj).Name;
      // worauf sich diese Komponente befindet
      if Obj is TWinControl then
        while Assigned(TWinControl(Obj).Parent) do begin
          Obj := TWinControl(Obj).Parent;
          if (Obj is TForm) or (Obj is TFrame) then begin
            S := S + '@' + Obj.UnitName + '.' + Obj.ClassName;
            if TComponent(Obj).Name <> '' then
              S := S + '-' + TComponent(Obj).Name;
          end;
        end;
    end;
  end;
  raise EIntfCastError.Create(S) at CallingAddress;
end;

procedure ExtendedIntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);
var
  Intf: IInterface;
begin
  if Source = nil then
    Dest := nil
  else if Source.QueryInterface(IID, Intf) = 0 then
    Dest := Intf
  else
    ExtendedIntfError(Source, IID, ReturnAddr);
end;

Das GUIDToString(IID) und // Interface-Bezeichnung suchen könnte ich zwar auslagern und nur bei Anzeige/Anfrage konvertieren und suchen, indem einfach nur die GUID (IID) in der Exception bespeichert würde, aber leider ist irgendwer auf die saublöde Idee gekommen Exception.Message nicht mit einem virtuellen Getter zu versehn, genauso wie Exception.StackTrace auch nicht virtual ist, so daß man wohl nicht umherkommt alles sofort zu erstellen und nicht erst, wenn wirlich benötigt.