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;