because of bail I the editor unindents now on pressing }. have fun!
This commit is contained in:
Christian Hammacher
742
editor/editor2/UnitfrmExceptionHandler.pas
Executable file
742
editor/editor2/UnitfrmExceptionHandler.pas
Executable file
@ -0,0 +1,742 @@
|
||||
{**************************************************************************************************}
|
||||
{ }
|
||||
{ Project JEDI Code Library (JCL) }
|
||||
{ }
|
||||
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
||||
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
||||
{ License at http://www.mozilla.org/MPL/ }
|
||||
{ }
|
||||
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
||||
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
||||
{ and limitations under the License. }
|
||||
{ }
|
||||
{ The Original Code is ExceptDlg.pas. }
|
||||
{ }
|
||||
{ The Initial Developer of the Original Code is documented in the accompanying }
|
||||
{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. }
|
||||
{ }
|
||||
{**************************************************************************************************}
|
||||
{ }
|
||||
{ Sample Application exception dialog replacement }
|
||||
{ }
|
||||
{ Last modified: April 1, 2003 }
|
||||
{ }
|
||||
{**************************************************************************************************}
|
||||
|
||||
unit UnitfrmExceptionHandler;
|
||||
|
||||
{$I jcl.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
StdCtrls, ExtCtrls, JclDebug;
|
||||
|
||||
const
|
||||
UM_CREATEDETAILS = WM_USER + $100;
|
||||
|
||||
ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property
|
||||
DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property
|
||||
|
||||
type
|
||||
TSimpleExceptionLog = class (TObject)
|
||||
private
|
||||
FLogFileHandle: THandle;
|
||||
FLogFileName: string;
|
||||
FLogWasEmpty: Boolean;
|
||||
function GetLogOpen: Boolean;
|
||||
protected
|
||||
function CreateDefaultFileName: string;
|
||||
public
|
||||
constructor Create(const ALogFileName: string = '');
|
||||
destructor Destroy; override;
|
||||
procedure CloseLog;
|
||||
procedure OpenLog;
|
||||
procedure Write(const Text: string; Indent: Integer = 0); overload;
|
||||
procedure Write(Strings: TStrings; Indent: Integer = 0); overload;
|
||||
procedure WriteStamp(SeparatorLen: Integer = 0);
|
||||
property LogFileName: string read FLogFileName;
|
||||
property LogOpen: Boolean read GetLogOpen;
|
||||
end;
|
||||
|
||||
TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls);
|
||||
TExcDialogSystemInfos = set of TExcDialogSystemInfo;
|
||||
|
||||
TExceptionDialog = class(TForm)
|
||||
OkBtn: TButton;
|
||||
DetailsMemo: TMemo;
|
||||
DetailsBtn: TButton;
|
||||
Bevel1: TBevel;
|
||||
TextLabel: TMemo;
|
||||
procedure FormPaint(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure DetailsBtnClick(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormResize(Sender: TObject);
|
||||
private
|
||||
FDetailsVisible: Boolean;
|
||||
FIsMainThead: Boolean;
|
||||
FLastActiveControl: TWinControl;
|
||||
FNonDetailsHeight: Integer;
|
||||
FFullHeight: Integer;
|
||||
FSimpleLog: TSimpleExceptionLog;
|
||||
procedure CreateDetails;
|
||||
function GetReportAsText: string;
|
||||
procedure ReportToLog;
|
||||
procedure SetDetailsVisible(const Value: Boolean);
|
||||
procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
|
||||
protected
|
||||
procedure AfterCreateDetails; dynamic;
|
||||
procedure BeforeCreateDetails; dynamic;
|
||||
procedure CreateDetailInfo; dynamic;
|
||||
procedure CreateReport(const SystemInfo: TExcDialogSystemInfos);
|
||||
function ReportMaxColumns: Integer; virtual;
|
||||
function ReportNewBlockDelimiterChar: Char; virtual;
|
||||
procedure NextDetailBlock;
|
||||
procedure UpdateTextLabelScrollbars;
|
||||
public
|
||||
procedure CopyReportToClipboard;
|
||||
class procedure ExceptionHandler(Sender: TObject; E: Exception);
|
||||
class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
|
||||
class procedure ShowException(E: Exception; Thread: TJclDebugThread);
|
||||
property DetailsVisible: Boolean read FDetailsVisible write SetDetailsVisible;
|
||||
property ReportAsText: string read GetReportAsText;
|
||||
property SimpleLog: TSimpleExceptionLog read FSimpleLog;
|
||||
end;
|
||||
|
||||
TExceptionDialogClass = class of TExceptionDialog;
|
||||
|
||||
var
|
||||
ExceptionDialogClass: TExceptionDialogClass = TExceptionDialog;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.DFM}
|
||||
|
||||
uses
|
||||
ClipBrd, Math,
|
||||
JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils;
|
||||
|
||||
resourcestring
|
||||
RsAppError = '%s - application error';
|
||||
RsExceptionClass = 'Exception class: %s';
|
||||
RsExceptionAddr = 'Exception address: %p';
|
||||
RsStackList = 'Stack list, generated %s';
|
||||
RsModulesList = 'List of loaded modules:';
|
||||
RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"';
|
||||
RsProcessor = 'Processor: %s, %s, %d MHz %s%s';
|
||||
RsScreenRes = 'Display : %dx%d pixels, %d bpp';
|
||||
RsActiveControl = 'Active Controls hierarchy:';
|
||||
RsThread = 'Thread: %s';
|
||||
RsMissingVersionInfo = '(no version info)';
|
||||
|
||||
var
|
||||
ExceptionDialog: TExceptionDialog;
|
||||
|
||||
//==================================================================================================
|
||||
// Helper routines
|
||||
//==================================================================================================
|
||||
|
||||
function GetBPP: Integer;
|
||||
var
|
||||
DC: HDC;
|
||||
begin
|
||||
DC := GetDC(0);
|
||||
Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
|
||||
ReleaseDC(0, DC);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function SortModulesListByAddressCompare(List: TStringList; Index1, Index2: Integer): Integer;
|
||||
begin
|
||||
Result := Integer(List.Objects[Index1]) - Integer(List.Objects[Index2]);
|
||||
end;
|
||||
|
||||
//==================================================================================================
|
||||
// TApplication.HandleException method code hooking for exceptions from DLLs
|
||||
//==================================================================================================
|
||||
|
||||
// We need to catch the last line of TApplication.HandleException method:
|
||||
// [...]
|
||||
// end else
|
||||
// SysUtils.ShowException(ExceptObject, ExceptAddr);
|
||||
// end;
|
||||
|
||||
procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer);
|
||||
begin
|
||||
if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >= Exception.InstanceSize) then
|
||||
TExceptionDialog.ExceptionHandler(nil, Exception(ExceptObject))
|
||||
else
|
||||
SysUtils.ShowException(ExceptObject, ExceptAddr);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function HookTApplicationHandleException: Boolean;
|
||||
const
|
||||
CallOffset = $86;
|
||||
CallOffsetDebug = $94;
|
||||
type
|
||||
PCALLInstruction = ^TCALLInstruction;
|
||||
TCALLInstruction = packed record
|
||||
Call: Byte;
|
||||
Address: Integer;
|
||||
end;
|
||||
var
|
||||
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
|
||||
CALLInstruction: TCALLInstruction;
|
||||
CallAddress: Pointer;
|
||||
NW: DWORD;
|
||||
|
||||
function CheckAddressForOffset(Offset: Cardinal): Boolean;
|
||||
begin
|
||||
try
|
||||
CallAddress := Pointer(Cardinal(TApplicationHandleExceptionAddr) + Offset);
|
||||
CALLInstruction.Call := $E8;
|
||||
Result := PCALLInstruction(CallAddress)^.Call = CALLInstruction.Call;
|
||||
if Result then
|
||||
begin
|
||||
if IsCompiledWithPackages then
|
||||
Result := PeMapImgResolvePackageThunk(Pointer(Integer(CallAddress) + Integer(PCALLInstruction(CallAddress)^.Address) + SizeOf(CALLInstruction))) = SysUtilsShowExceptionAddr
|
||||
else
|
||||
Result := PCALLInstruction(CallAddress)^.Address = Integer(SysUtilsShowExceptionAddr) - Integer(CallAddress) - SizeOf(CALLInstruction);
|
||||
end;
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException);
|
||||
SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException);
|
||||
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
|
||||
if Result then
|
||||
begin
|
||||
CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
|
||||
Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW);
|
||||
if Result then
|
||||
FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
|
||||
end;
|
||||
end;
|
||||
|
||||
//==================================================================================================
|
||||
// TSimpleExceptionLog
|
||||
//==================================================================================================
|
||||
|
||||
procedure TSimpleExceptionLog.CloseLog;
|
||||
begin
|
||||
if LogOpen then
|
||||
begin
|
||||
CloseHandle(FLogFileHandle);
|
||||
FLogFileHandle := INVALID_HANDLE_VALUE;
|
||||
FLogWasEmpty := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
constructor TSimpleExceptionLog.Create(const ALogFileName: string);
|
||||
begin
|
||||
if ALogFileName = '' then
|
||||
FLogFileName := CreateDefaultFileName
|
||||
else
|
||||
FLogFileName := ALogFileName;
|
||||
FLogFileHandle := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function TSimpleExceptionLog.CreateDefaultFileName: string;
|
||||
begin
|
||||
Result := PathExtractFileDirFixed(ParamStr(0)) + PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log';
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
destructor TSimpleExceptionLog.Destroy;
|
||||
begin
|
||||
CloseLog;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function TSimpleExceptionLog.GetLogOpen: Boolean;
|
||||
begin
|
||||
Result := FLogFileHandle <> INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TSimpleExceptionLog.OpenLog;
|
||||
begin
|
||||
if not LogOpen then
|
||||
begin
|
||||
FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE, FILE_SHARE_READ, nil,
|
||||
OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
|
||||
if LogOpen then
|
||||
FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0;
|
||||
end
|
||||
else
|
||||
FLogWasEmpty := False;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TSimpleExceptionLog.Write(const Text: string; Indent: Integer);
|
||||
var
|
||||
S: string;
|
||||
SL: TStringList;
|
||||
I: Integer;
|
||||
begin
|
||||
if LogOpen then
|
||||
begin
|
||||
SL := TStringList.Create;
|
||||
try
|
||||
SL.Text := Text;
|
||||
for I := 0 to SL.Count - 1 do
|
||||
begin
|
||||
S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I]));
|
||||
FileWrite(Integer(FLogFileHandle), Pointer(S)^, Length(S));
|
||||
end;
|
||||
finally
|
||||
SL.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: Integer);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to Strings.Count - 1 do
|
||||
Write(Strings[I], Indent);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: Integer);
|
||||
begin
|
||||
if SeparatorLen = 0 then
|
||||
SeparatorLen := 100;
|
||||
SeparatorLen := Max(SeparatorLen, 20);
|
||||
OpenLog;
|
||||
if not FLogWasEmpty then
|
||||
Write(AnsiCrLf);
|
||||
Write(StrRepeat('=', SeparatorLen));
|
||||
Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)]));
|
||||
Write(StrRepeat('=', SeparatorLen));
|
||||
end;
|
||||
|
||||
//==================================================================================================
|
||||
// Exception dialog
|
||||
//==================================================================================================
|
||||
|
||||
var
|
||||
ExceptionShowing: Boolean;
|
||||
|
||||
{ TExceptionDialog }
|
||||
|
||||
procedure TExceptionDialog.AfterCreateDetails;
|
||||
begin
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.BeforeCreateDetails;
|
||||
begin
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.CopyReportToClipboard;
|
||||
begin
|
||||
ClipBoard.AsText := ReportAsText;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.CreateDetailInfo;
|
||||
begin
|
||||
CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.CreateDetails;
|
||||
begin
|
||||
Screen.Cursor := crHourGlass;
|
||||
DetailsMemo.Lines.BeginUpdate;
|
||||
try
|
||||
CreateDetailInfo;
|
||||
ReportToLog;
|
||||
DetailsMemo.SelStart := 0;
|
||||
SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0);
|
||||
AfterCreateDetails;
|
||||
finally
|
||||
DetailsMemo.Lines.EndUpdate;
|
||||
OkBtn.Enabled := True;
|
||||
DetailsBtn.Enabled := True;
|
||||
OkBtn.SetFocus;
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.CreateReport(const SystemInfo: TExcDialogSystemInfos);
|
||||
const
|
||||
MMXText: array[Boolean] of PChar = ('', 'MMX');
|
||||
FDIVText: array[Boolean] of PChar = (' [FDIV Bug]', '');
|
||||
var
|
||||
SL: TStringList;
|
||||
I: Integer;
|
||||
ModuleName: TFileName;
|
||||
CpuInfo: TCpuInfo;
|
||||
C: TWinControl;
|
||||
NtHeaders: PImageNtHeaders;
|
||||
ModuleBase: Cardinal;
|
||||
ImageBaseStr: string;
|
||||
StackList: TJclStackInfoList;
|
||||
begin
|
||||
SL := TStringList.Create;
|
||||
try
|
||||
// Stack list
|
||||
if siStackList in SystemInfo then
|
||||
begin
|
||||
StackList := JclLastExceptStackList;
|
||||
if Assigned(StackList) then
|
||||
begin
|
||||
DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
|
||||
StackList.AddToStrings(DetailsMemo.Lines, False, True, True);
|
||||
NextDetailBlock;
|
||||
end;
|
||||
end;
|
||||
// System and OS information
|
||||
if siOsInfo in SystemInfo then
|
||||
begin
|
||||
DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
|
||||
Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
|
||||
GetCpuInfo(CpuInfo);
|
||||
with CpuInfo do
|
||||
DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName,
|
||||
RoundFrequency(FrequencyInfo.NormFreq),
|
||||
MMXText[MMX], FDIVText[IsFDIVOK]]));
|
||||
DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
|
||||
NextDetailBlock;
|
||||
end;
|
||||
// Modules list
|
||||
if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then
|
||||
begin
|
||||
DetailsMemo.Lines.Add(RsModulesList);
|
||||
SL.CustomSort(SortModulesListByAddressCompare);
|
||||
for I := 0 to SL.Count - 1 do
|
||||
begin
|
||||
ModuleName := SL[I];
|
||||
ModuleBase := Cardinal(SL.Objects[I]);
|
||||
DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName]));
|
||||
NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase));
|
||||
if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then
|
||||
ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase])
|
||||
else
|
||||
ImageBaseStr := StrRepeat(' ', 11);
|
||||
if VersionResourceAvailable(ModuleName) then
|
||||
with TJclFileVersionInfo.Create(ModuleName) do
|
||||
try
|
||||
DetailsMemo.Lines.Add(ImageBaseStr + BinFileVersion + ' - ' + FileVersion);
|
||||
if FileDescription <> '' then
|
||||
DetailsMemo.Lines.Add(StrRepeat(' ', 11) + FileDescription);
|
||||
finally
|
||||
Free;
|
||||
end
|
||||
else
|
||||
DetailsMemo.Lines.Add(ImageBaseStr + RsMissingVersionInfo);
|
||||
end;
|
||||
NextDetailBlock;
|
||||
end;
|
||||
// Active controls
|
||||
if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then
|
||||
begin
|
||||
DetailsMemo.Lines.Add(RsActiveControl);
|
||||
C := FLastActiveControl;
|
||||
while C <> nil do
|
||||
begin
|
||||
DetailsMemo.Lines.Add(Format('%s "%s"', [C.ClassName, C.Name]));
|
||||
C := C.Parent;
|
||||
end;
|
||||
NextDetailBlock;
|
||||
end;
|
||||
finally
|
||||
SL.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.DetailsBtnClick(Sender: TObject);
|
||||
begin
|
||||
DetailsVisible := not DetailsVisible;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
class procedure TExceptionDialog.ExceptionHandler(Sender: TObject; E: Exception);
|
||||
begin
|
||||
if ExceptionShowing then
|
||||
Application.ShowException(E)
|
||||
else
|
||||
begin
|
||||
ExceptionShowing := True;
|
||||
try
|
||||
ShowException(E, nil);
|
||||
finally
|
||||
ExceptionShowing := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread);
|
||||
begin
|
||||
if ExceptionShowing then
|
||||
Application.ShowException(Thread.SyncException)
|
||||
else
|
||||
begin
|
||||
ExceptionShowing := True;
|
||||
try
|
||||
ShowException(Thread.SyncException, Thread);
|
||||
finally
|
||||
ExceptionShowing := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FSimpleLog := TSimpleExceptionLog.Create;
|
||||
FFullHeight := ClientHeight;
|
||||
DetailsVisible := False;
|
||||
Caption := Format(RsAppError, [Application.Title]);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FSimpleLog);
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if (Key = Ord('C')) and (ssCtrl in Shift) then
|
||||
begin
|
||||
CopyReportToClipboard;
|
||||
MessageBeep(MB_OK);
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormPaint(Sender: TObject);
|
||||
begin
|
||||
DrawIcon(Canvas.Handle, TextLabel.Left - GetSystemMetrics(SM_CXICON) - 15,
|
||||
TextLabel.Top, LoadIcon(0, IDI_ERROR));
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormResize(Sender: TObject);
|
||||
begin
|
||||
UpdateTextLabelScrollbars;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.FormShow(Sender: TObject);
|
||||
begin
|
||||
BeforeCreateDetails;
|
||||
MessageBeep(MB_ICONERROR);
|
||||
if FIsMainThead and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
|
||||
PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
|
||||
else
|
||||
CreateDetails;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function TExceptionDialog.GetReportAsText: string;
|
||||
begin
|
||||
Result := StrEnsureSuffix(AnsiCrLf, TextLabel.Text) + AnsiCrLf + DetailsMemo.Text;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.NextDetailBlock;
|
||||
begin
|
||||
DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns));
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function TExceptionDialog.ReportMaxColumns: Integer;
|
||||
begin
|
||||
Result := 100;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
function TExceptionDialog.ReportNewBlockDelimiterChar: Char;
|
||||
begin
|
||||
Result := '-';
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.ReportToLog;
|
||||
begin
|
||||
if Tag and ReportToLogEnabled <> 0 then
|
||||
begin
|
||||
FSimpleLog.WriteStamp(ReportMaxColumns);
|
||||
try
|
||||
FSimpleLog.Write(ReportAsText);
|
||||
finally
|
||||
FSimpleLog.CloseLog;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.SetDetailsVisible(const Value: Boolean);
|
||||
var
|
||||
DetailsCaption: string;
|
||||
begin
|
||||
FDetailsVisible := Value;
|
||||
DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, ['<', '>']));
|
||||
if Value then
|
||||
begin
|
||||
Constraints.MinHeight := FNonDetailsHeight + 100;
|
||||
Constraints.MaxHeight := Screen.Height;
|
||||
DetailsCaption := '<< ' + DetailsCaption;
|
||||
ClientHeight := FFullHeight;
|
||||
DetailsMemo.Height := FFullHeight - DetailsMemo.Top - 3;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FFullHeight := ClientHeight;
|
||||
DetailsCaption := DetailsCaption + ' >>';
|
||||
if FNonDetailsHeight = 0 then
|
||||
begin
|
||||
ClientHeight := Bevel1.Top;
|
||||
FNonDetailsHeight := Height;
|
||||
end
|
||||
else
|
||||
Height := FNonDetailsHeight;
|
||||
Constraints.MinHeight := FNonDetailsHeight;
|
||||
Constraints.MaxHeight := FNonDetailsHeight
|
||||
end;
|
||||
DetailsBtn.Caption := DetailsCaption;
|
||||
DetailsMemo.Enabled := Value;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
class procedure TExceptionDialog.ShowException(E: Exception; Thread: TJclDebugThread);
|
||||
begin
|
||||
if ExceptionDialog = nil then
|
||||
ExceptionDialog := ExceptionDialogClass.Create(Application);
|
||||
try
|
||||
with ExceptionDialog do
|
||||
begin
|
||||
FIsMainThead := (GetCurrentThreadId = MainThreadID);
|
||||
FLastActiveControl := Screen.ActiveControl;
|
||||
TextLabel.Text := AdjustLineBreaks(StrEnsureSuffix('.', E.Message));
|
||||
UpdateTextLabelScrollbars;
|
||||
DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName]));
|
||||
if Thread = nil then
|
||||
DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr]))
|
||||
else
|
||||
DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo]));
|
||||
NextDetailBlock;
|
||||
ShowModal;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(ExceptionDialog);
|
||||
end;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.UMCreateDetails(var Message: TMessage);
|
||||
begin
|
||||
Update;
|
||||
CreateDetails;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure TExceptionDialog.UpdateTextLabelScrollbars;
|
||||
begin
|
||||
if Tag and DisableTextScrollbar = 0 then
|
||||
begin
|
||||
Canvas.Font := TextLabel.Font;
|
||||
if TextLabel.Lines.Count * Canvas.TextHeight('Wg') > TextLabel.ClientHeight then
|
||||
TextLabel.ScrollBars := ssVertical
|
||||
else
|
||||
TextLabel.ScrollBars := ssNone;
|
||||
end;
|
||||
end;
|
||||
|
||||
//==================================================================================================
|
||||
// Exception handler initialization code
|
||||
//==================================================================================================
|
||||
|
||||
procedure InitializeHandler;
|
||||
begin
|
||||
JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
|
||||
{$IFNDEF HOOK_DLL_EXCEPTIONS}
|
||||
JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
|
||||
{$ENDIF HOOK_DLL_EXCEPTIONS}
|
||||
JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler;
|
||||
JclStartExceptionTracking;
|
||||
{$IFDEF HOOK_DLL_EXCEPTIONS}
|
||||
if HookTApplicationHandleException then
|
||||
JclTrackExceptionsFromLibraries;
|
||||
{$ENDIF HOOK_DLL_EXCEPTIONS}
|
||||
Application.OnException := TExceptionDialog.ExceptionHandler;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure UnInitializeHandler;
|
||||
begin
|
||||
Application.OnException := nil;
|
||||
JclDebugThreadList.OnSyncException := nil;
|
||||
JclUnhookExceptions;
|
||||
JclStopExceptionTracking;
|
||||
end;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
initialization
|
||||
{$IFDEF EXCEPTION_DEBUG}
|
||||
InitializeHandler;
|
||||
{$ENDIF}
|
||||
|
||||
finalization
|
||||
{$IFDEF EXCEPTION_DEBUG}
|
||||
UnInitializeHandler;
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user