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.
