Delphi-System-Funktion ersetzen

[himitsu]

Wie kann ich eine Funktion aus der unit System überschreiben/ersetzen?

Ich hab hier ein Problem "Interface nicht unterstützt", welches ich einfach nicht gelöst bekomme.
Im Programm läuft es, aber in der IDE bekomme ich einige Formulare einfach nicht mehr geöffnet. (PAS wird geladen, aber nicht die DFM)
Da ist einfach kein Arbeiten möglich, wenn man die IDE nicht nutzen kann. (statt einen Bug 15-30 Minuten lang mit Hilfe des Formdesigners zu suchen, hab ich mich über 1,5 Stunden durch die DFM als Text gequält)

Ich vermute, daß es irgendwo ein Problem in unseren Komponenten/Packages ist,
aber egal wie ich die IDE debugge, ich finde die Fehlerstelle nicht und wenn, dann schafft es Delphi einfach nicht den Stacktrace (ordentlich) anzuzeigen, so daß ich die eigentliche fehlerauslösende Stelle finden könnte.

Nun hab ich eine Funktion, welche die Fehlermeldung etwas verständlicher macht.
Und diese müßte jetzt "blos" noch mit System._InftCast (so heißt es in der system.pas) oder vielleicht auch sowas wie System.IntfCast ersetzen.

Also quasi ein

Delphi-Quellcode:

MOV EAX, @ExtendedIntfCast
JMP EAX

bei dieser Funktion einfügen/drüberschreiben.

Aber ich kann die Adresse diese Prozedur, bzw. ihren öffentlich Namen, einfach nicht finden.
In der System.pas steht die _IntfCast zwar im Interface-Bereich, aber das hat ja (bei dieser Unit) nix zu sagen.

Delphi-Quellcode:

uses
  SysConst, SysUtils, Classes, Controls, Forms, RTTI;

procedure ExtendedIntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);
// PIC:  EBX must be correct before calling QueryInterface
function ReturnAddr: Pointer;
  asm
    MOV EAX, [EBP+4]
  end;
function Compare(const G1, G2: TGUID): Boolean;
  begin
    Result := CompareMem(@G1, @G2, SizeOf(TGUID));
  end;
const
  ObjCastGUID: TGUID = '{CEDF24DE-80A4-447D-8C75-EB871DC121FD}';
var
  Intf: IInterface;
  Obj:  TObject;
  S:    string;
  RTyp: TRttiType;
begin
  if Source <> nil then begin
    if Source.QueryInterface(IID, Intf) <> 0 then 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) and Compare(TRttiInterfaceType(RTyp).GUID, IID) then
          S := S + ' = ' + TRttiInterfaceType(RTyp).DeclaringUnitName + '.' + TRttiInterfaceType(RTyp).Name;
      // 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 ReturnAddr;
    end else
      Dest := Intf;
  end else
    Dest := nil;
end;

[shmia]

http://www.delphipraxis.net/21619-um...saufrufen.html
Handle with care :wink:

[himitsu]

Ist gut und schön und im Prinzip funktioniert es,

wenn man den Zeiger zur Funktion kennt/bekommt.
Und das ist mein Hauptproblem ... an den komm ich nicht ran. :cry:

Delphi-Quellcode:

begin
  p := @_IntfCast;
  p := @IntfCast;
  p := @System._IntfCast;
  p := @System.IntfCast;
end;

asm
  call _IntfCast;
  call IntfCast;
  call System._IntfCast;
  call System.IntfCast;
end;

Es heißt immer _IntfCast oder IntfCast sei unbekannt.

[shmia]

Also bei meinem Delphi 5 kommt vor den Funktionen IntfClear() und IntfCast() die Funktion LoadResString();
Man könnte nun den Zeiger auf LoadResString() anfordern und einen festen Offset dazuaddieren.
Um an den Offset zu kommen muss man sich die Adressen der Funktionen im CPU-Fenster anzeigen lassen und voneinander abziehen.
Das ist natürlich sehr unsauber aber der Zweck heiligt die Mittel.

Delphi-Quellcode:

// Codebeispiel um die Funktion IntfCast zu finden
procedure TForm1.ButtonTestClick(Sender: TObject);
var
   i : IDispatch;
   t : IUnknown;
begin
   // Breakpoint
   asm
      int 3
   end;
   // CPU-Fenster anzeigen lassen und per Singlestep weiter bis @IntfCast gehen
   i := t as IDispatch;
end;

[guinnes]

Das wird wohl an der Compiler-Magic liegen.

In einem Contruct wie BlaBla := Fu as Bar sollte die Funktion aufgerufen werden ( Kann man ja im integrierten Disassembler überprüfen )

Mist, zu langsam

[Thom]

Delphi-Quellcode:

function GetIntfCastAddr: Pointer;
asm
  lea eax,System.@IntfCast;
end;

[himitsu]

Zitat:

Zitat von Thom (Beitrag 1153867)

Delphi-Quellcode:

function GetIntfCastAddr: Pointer;
asm
  lea eax,System.@IntfCast;
end;

Hatte zwar schon einige Varianten durchprobiert.
Ich würde dich abknutschen, aber ich glaub ich laß das.

Delphi-Quellcode:

var
  PIntfCast: Pointer;

begin
  RedirectProcedureCall(Pointer($004099E8), @ExtendedIntfCast);

  RedirectProcedureCall(Pointer(NativeInt(@TInterfacedObject.AfterConstruction) - 60), @ExtendedIntfCast);

  asm
    LEA EAX, System.@IntfCast
    MOV &PIntfCast, EAX
  end;
  RedirectProcedureCall(PIntfCast, @ExtendedIntfCast);

Da ich diese Funktion auch demnächte veröffentlichen würde (in 'ner Unit verpackt), gefällt mir Letzeres natürlich besser.
(muß dann nur noch irgendwann mal sehn, wie das mit Win64 und Co. aussieht)

[Bummi]

@himitsu
das sieht irgendwie abenteuerlich um nicht zu sagen bedrohlich aus :)

[himitsu]

Was davon?

[Bummi]

alles, aber das dürfte daran liegen dass ich Dir nicht mehr folgen kann :oops:

[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. :cry:

[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. :angle:

[Bummi]

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

[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

Delphi-Quellcode:

raise Exception.Create;

hält der Compiler beim RAISE, wärend beim

Delphi-Quellcode:

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


@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

Delphi-Quellcode:

GUIDToString(IID)

und

Delphi-Quellcode:

// 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. :wall: