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: