{-----------------------------------------------------------------------------
Procedure: AppEventsException
Date: 04.10.2012
Arguments: Sender: TObject; E: Exception
Result: None
Purpose: Ausgabe von Fehlermeldungen.
Diese Routine wird beim Auftreten von Exceptions aufgerufen.
-----------------------------------------------------------------------------}
procedure TSBAutoRegistry.AppEventsException(Sender: TObject; E:
Exception);
Var
sExceptionClassMessage :
String;
sDebugMessage :
String;
sMessage :
String;
sAddr :
String;
sOwner :
String;
dbgLocInfo : TJclLocationInfo;
begin
try
// Ist Fehlerverursacher eine Komponente oder deren Nachfolger?
if Sender
is TComponent
then begin
// Hat sie einen Owner?
if HasProperty(Sender, '
Owner')
then begin
// Dann diesen ermitteln
sOwner := GetStrProp(Sender,'
Owner');
// und die Fehlermeldung zusammen bauen.
sExceptionClassMessage := Format('
%s, Fehlertyp: %s, Sender: %s [%s], Owner: %s',
[E.
Message,
E.ClassName,
TComponent(Sender).
Name,
Sender.ClassName,
sOwner
]);
// Sollen Debugfehlermeldungen erstellt werden?
if fDebugMessages
then begin
sDebugMessage := Format('
%s',[E.
Message]) + #13 + #13
+ Format('
Fehlertyp: %s',[E.ClassName]) + #13
+ Format('
Sender: %s [%s]',[TComponent(Sender).
Name,
Sender.ClassName]) + #13
+ Format('
Owner: %s',[sOwner]) + #13;
end;
end else begin
// Es gibt keinen Owner
// und die Fehlermeldung zusammen bauen.
sExceptionClassMessage := Format('
%s, Fehlertyp: %s, Sender: %s [%s]',
[E.
Message,
E.ClassName,
TComponent(Sender).
Name,
Sender.ClassName
]);
// Sollen Debugfehlermeldungen erstellt werden?
if fDebugMessages
then begin
sDebugMessage := Format('
%s',[E.
Message]) + #13 + #13
+ Format('
Fehlertyp: %s',[E.ClassName]) + #13
+ Format('
Sender: %s [%s]',[TComponent(Sender).
Name,
Sender.ClassName]) + #13;
end;
end;
end else begin
// Der Fehlerverursacher ist keine Komponente oder einer ihrer Nachfolger.
sExceptionClassMessage := Format('
%s, Fehlertyp: %s, Sender: %s',
[E.
Message,
E.ClassName,
Sender.ClassName
]);
// Sollen Debugfehlermeldungen erstellt werden?
if fDebugMessages
then begin
sDebugMessage := Format('
%s',[E.
Message]) + #13 + #13
+ Format('
Fehlertyp: %s',[E.ClassName]) + #13
+ Format('
Sender: %s',[Sender.ClassName]) + #13;
end;
end;
finally
end;
// Von der JCL genauere Fehlerinformationen ermitteln lassen
dbgLocInfo := GetLocationInfo(ExceptAddr);
// und diese in eine lesbare Zeichenfolge bringen lassen.
sMessage := GetLocationInfoStr(ExceptAddr, True, True, True, True);
// Einen Teil davon möchten wir jedoch separat haben.
sAddr := Copy(sMessage,2,Pos('
)',sMessage) - 2);
// Und die Fehlermeldung in die LOG-Datei ausgeben.
WriteAppLog(sExceptionClassMessage);
WriteAppLog(sMessage);
WriteAppLog(Format('
Dateiname: %s',[ExtractFileName(dbgLocInfo.DebugInfo.FileName)]));
WriteAppLog(Format('
Fehleradresse: %s',[sAddr]));
WriteAppLog(Format('
Unit: %s',[dbgLocInfo.UnitName]));
WriteAppLog(Format('
Fehleradresse: %p',[dbgLocInfo.Address]));
WriteAppLog(Format('
Modulname: %s',[dbgLocInfo.SourceName]));
WriteAppLog(Format('
Prozedur: %s',[dbgLocInfo.ProcedureName]));
WriteAppLog(Format('
Prozeduroffset: %d',[dbgLocInfo.OffsetFromProcName]));
WriteAppLog(Format('
Zeilennummer: %d',[dbgLocInfo.LineNumber]));
WriteAppLog(Format('
Zeilenoffset: %d',[dbgLocInfo.OffsetFromLineNumber]));
WriteAppLog(Format('
Modul: %d [%x]',[dbgLocInfo.DebugInfo.Module, dbgLocInfo.DebugInfo.Module]));
if fDebugMessages
then begin
// Dann hier eine entsprechende Zeichenfolge zusammenbauen.
sDebugMessage := sDebugMessage + #13
+ Format('
Dateiname: %s',[ExtractFileName(dbgLocInfo.DebugInfo.FileName)]) + #13
+ Format('
Fehleradresse: %s',[sAddr]) + #13 + #13
+ Format('
Unit: %s',[dbgLocInfo.UnitName]) + #13
+ Format('
Fehleradresse: %p',[dbgLocInfo.Address]) + #13
+ Format('
Modulname: %s',[dbgLocInfo.SourceName]) + #13 + #13
+ Format('
Prozedur: %s',[dbgLocInfo.ProcedureName]) + #13
+ Format('
Prozeduroffset: %d',[dbgLocInfo.OffsetFromProcName]) + #13
+ Format('
Zeilennummer: %d',[dbgLocInfo.LineNumber]) + #13
+ Format('
Zeilenoffset: %d',[dbgLocInfo.OffsetFromLineNumber])
// + #13 + #13
// + Format('Modul: %d [%x]',[dbgLocInfo.DebugInfo.Module, dbgLocInfo.DebugInfo.Module])
// + Format('BinaryFile: %s',[dbgLocInfo.BinaryFileName]) + #13
;
end else begin
sDebugMessage := e.
Message;
end;
// Ist eine Ereignisroutine für die Fehlerausgabe... zugewiesen?
if Assigned(fOnAppExceptionEvent)
then begin
fOnAppExceptionEvent(self,sDebugMessage);
end else begin
// Wenn keine Ereignisroutine für die Fehlerbehandlung zugewiesen ist,
// geben wir hier selbst eine Fehlermeldung aus.
MessageDlg(sDebugMessage, mtError, [mbOk], 0);
end;
end;