{
Unit : uStackTrace
Purpose : Helper class for logging stacktraces upon unhandled exceptions. When
this unit is included in the first unit for the project, it will use
the stacktrace logging exposed through the JclDebugger. For this unit
to work, the jvcl must be installed, the option "insert JCL debug data"
must be enabled under the project menu and in the project options
"debug information" and "detailed map file" must be checked.
}
unit uStackTrace;
interface
uses
Windows, Classes, SysUtils,
uEnvironmentFactory, uAppUtils, uIAppConst, uInitializationHandler,
IdException, JclDebug, JclHookExcept, JclFileUtils, uXMLOutput, uIUserSession;
procedure LogException(ExceptObj : TObject;
ExceptAddr : Pointer;
OSException : Boolean);
procedure AddIgnoreException(ExceptionClass: ExceptClass);
implementation
var
InternalIgnoreList: TList = nil;
{
Procedure : AddIgnoreException
Purpose : Add exception classes to be ignored by the stack tracer.
}
procedure AddIgnoreException(ExceptionClass: ExceptClass);
begin
if not Assigned(InternalIgnoreList) then
InternalIgnoreList := TList.Create;
if InternalIgnoreList.IndexOf(ExceptionClass) = -1 then
InternalIgnoreList.Add(ExceptionClass);
end;
{
Procedure : IsIgnoreException
Purpose : Check if the given class should be ignored by the stack tracer.
}
function IsIgnoreException(ExceptionClass: TClass): Boolean;
begin
Result := Assigned(InternalIgnoreList) and (InternalIgnoreList.IndexOf(ExceptionClass) > -1)
Result := False;
end;
{
Procedure : LogException
Purpose : LogException is called by JclDebug, when an unhandled exception is
thrown. We log the accompanying stacktrace here.
}
procedure LogException(ExceptObj : TObject;
ExceptAddr : Pointer;
OSException: Boolean);
var
StackTrace : TStringList;
ExceptionMessage : String;
LogName : String;
XMLUtil : TXMLUtils;
XMLSession : String;
Session : IUserSession;
begin
if IsIgnoreException(ExceptObj.ClassType) then
Exit;
StackTrace := TStringList.Create;
try
LogName := FormatDateTime('yyyymmddhhnnsszzz', Now);
JclLastExceptStackListToStrings(StackTrace, True, True, True);
// Try to obtain the exception message
try
ExceptionMessage := (ExceptObj as Exception).Message
except
ExceptionMessage := 'Unknown uncaught exception';
end;
StackTrace.Add('');
StackTrace.Add('Caused by: (' + ExceptObj.ClassName + ') ' + ExceptionMessage );
// Always write exceptions to an file, the environment may not have been initialized yet,
// which would make the default logger unavailable
StackTrace.SaveToFile(GetApplicationPath + '\logs\exception-' + LogName + '.log');
finally
StackTrace.Free;
end;
end;
initialization
JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
JclStackTrackingOptions := JclStackTrackingOptions + [stExceptFrame];
JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
JclStartExceptionTracking;
JclAddExceptNotifier(LogException);
finalization
JclStopExceptionTracking;
JclRemoveExceptNotifier(LogException);
FreeAndNil(InternalIgnoreList);
end.
Bookmarks