// See also: https://pastebin.com/rvsPpWpf - "how to create custom error dialog" // See also: https://pastebin.com/BFhcdsnh - "how to replace dialog icon" // See also: https://pastebin.com/jrEcvkkv - "how to change format of bug report file" // See also: https://pastebin.com/46QkwZNi - "how to convert call stack to text" // IMPORTANT NOTE // We consider using VCL/FMX forms as exception dialogs to be bad practice for the following reasons: // - VCL is not thread safe. You won't be able to show exception dialog for each background thread. Exception info must be send back to main thread in order to show dialog. // - VCL is a complex library. If you get some exception which damages VCL - then you won't be able to show exception dialog built with VCL. // For the above reason, EurekaLog does not use VCL or FMX, but implements exception dialogs with naked WinAPI. // Consider yourself warned. // You can implement EurekaLog 7 exception dialog in the same style as in EurekaLog 6: by utilizing event handler. // Just add EEvents unit to uses, register your own OnExceptionNotify handler // ( http://www.eurekalog.com/help/eurekalog/topic_type_eevents_televexceptionnotifymeth.php ), // and show your form. // This, however, is not recommended approach, // as you won't get access to any of already written dialog code // and won't be able to use many helper routines. // But the plus side is that your old code from EurekaLog 6 will remain mostly unmodified. // Best approach would be to implement dialog in EurekaLog 7 style - by declaring your own dialog class: unit UnitExceptionDialog; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, EDialog, // for TBaseDialog and RegisterDialogClass EException, // for TEurekaExceptionInfo EClasses, // for TEurekaModuleOptions ETypes; // for TResponse and other simple EurekaLog types type // My exception dialog TMyExeptionDialog = class(TBaseDialog) protected function ShowModalInternal: TResponse; override; public class function ThreadSafe: Boolean; override; end; // Form for my exception dialog TMyExeptionDialogForm = class(TForm) URLLabel: TLabel; ListBox: TListBox; CopyButton: TButton; TryButton: TButton; ExitButton: TButton; SendAndTry: TButton; procedure FormCreate(Sender: TObject); procedure SendAndTryClick(Sender: TObject); procedure TryButtonClick(Sender: TObject); procedure ExitButtonClick(Sender: TObject); procedure CopyButtonClick(Sender: TObject); procedure URLLabelClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FDialog: TMyExeptionDialog; FExceptionInfo: TEurekaExceptionInfo; FOptions: TEurekaModuleOptions; protected property Dialog: TMyExeptionDialog read FDialog; property ExceptionInfo: TEurekaExceptionInfo read FExceptionInfo; property Options: TEurekaModuleOptions read FOptions; public constructor Create(const ADialog: TMyExeptionDialog); reintroduce; end; implementation uses Clipbrd, ECore, // for ShellExec EDebugInfo, // for LocationToStr EInfoFormat, // for various FmtXYZ functions ESysInfo, // for various GetXYZ functions EModules; // for CurrentEurekaLogOptions {$R *.dfm} { TMyExeptionDialog } function TMyExeptionDialog.ShowModalInternal: TResponse; var fmExceptionDialogForm: TMyExeptionDialogForm; begin try // Create form and setup form fmExceptionDialogForm := TMyExeptionDialogForm.Create(Self { <- important } ); try // Show form case fmExceptionDialogForm.ShowModal of mrYes: // see TMyExeptionDialogForm.SendAndTryClick below begin // Set result, which means "all is OK, send bug report (if that is set in options)" Finalize(Result); FillChar(Result, SizeOf(Result), 0); Result.SendResult := srSent; end; mrOK: // see TMyExeptionDialogForm.TryClick below begin // Set result, which means "all is OK, but do not send bug report" Finalize(Result); FillChar(Result, SizeOf(Result), 0); Result.SendResult := srCancelled; end; mrCancel: // see TMyExeptionDialogForm.ExitButtonClick below begin RestartApplication; // <- to restart application immediately // TerminateApplication; // <- to terminate application immediately // SetTerminateApplication(True); // <- you can use this in CheckBox.OnClick - for delayed termination on exit end; else begin // Set default result Finalize(Result); FillChar(Result, SizeOf(Result), 0); Result.SendResult := srSent; end; end; // You may also try other options: // Result.SendResult := srRestart; // <- "show me another dialog, please" // Options.ExceptionDialogType := edtEurekaLogDetailed; // <- dialog to show (in this case: detailed EurekaLog dialog with bug report and call stack) // Options.CustomField[difDetailsFallbackClass] := ClassName; // <- remember this dialog, if edtEurekaLogDetailed will revert back // Options.CustomFieldInt[difOldSendResult] := Ord(srSent); // <- what is result for current dialog, srSent or srCancelled // The above could be replaced with simple: // ShowDetails; // <- this will setup FResponse with the above code // Result := FResponse; // You can also use the following: // ShowAskReproduce; // <- this will switch dialog to "ask steps to reproduce" dialog // Result := FResponse; finally FreeAndNil(fmExceptionDialogForm); end; except on E: Exception do begin // Indicate that dialog failed: Finalize(Result); FillChar(Result, SizeOf(Result), 0); Result.SendResult := srUnknownError; if E is EOSError then Result.ErrorCode := EOSError(E).ErrorCode else Result.ErrorCode := ERROR_GEN_FAILURE; Result.ErrorMessage := E.Message; end; end; end; class function TMyExeptionDialog.ThreadSafe: Boolean; begin Result := False; // VCL is not thread safe, indicate this end; { TMyExeptionDialogForm } constructor TMyExeptionDialogForm.Create(const ADialog: TBaseDialog); begin FDialog := ADialog; FExceptionInfo := FDialog.ExceptionInfo; FOptions := FDialog.Options; inherited Create(nil); end; procedure TMyExeptionDialogForm.FormCreate(Sender: TObject); var I, C: Integer; Error: Exception; begin // Get exception object - in case you want to use it (not used in this example, though) if Assigned(ExceptionInfo.ExceptionObject) and ExceptionInfo.ExceptionNative then Error := Exception(ExceptionInfo.ExceptionObject) else Error := nil; // will be nil for, say, ANSI exceptions from DLL caught in UNICODE exe ListBox.Clear; // Add some exception information: ListBox.Items.Add(FmtPointerToStr(ExceptionInfo.Address)); ListBox.Items.Add(ExceptionInfo.ClassName); ListBox.Items.Add(ExceptionInfo.ExceptionMessage); // Add at most 5 items with line numbers from call stack C := 0; for I := 0 to ExceptionInfo.CallStack.Count - 1 do if ExceptionInfo.CallStack[I].Location.LineNumber > 0 then begin ListBox.Items.Add(LocationToStr(ExceptionInfo.CallStack[I].Location, False, False, False, False, False, True)); Inc(C); if C > 5 then Break; end; // Add some system information from bug report ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSType], GetOSTypeStr])); ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSBuildN], GetOSBuild])); ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSUpdate], GetOSUpdate])); ListBox.Items.Add(Format('%s: %s (%s)', [Options.CustomizedExpandedTexts[mtLog_OSLanguage], GetOSNonUnicodeLanguage, GetOSCharset])); ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpTotalMemory], FmtSize(GetTotalMemory)])); ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpFreeMemory], FmtSize(GetFreeMemory)])); ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpTotalDisk], FmtSize(GetTotalDisk)])); // Add some custom information ListBox.Items.Add('Application License: ' + {$IFDEF ENTERPRISE}'ENT'{$ELSE}'STD'{$ENDIF}); end; procedure TMyExeptionDialogForm.URLLabelClick(Sender: TObject); begin // Open your web-site and (optionally) supply exception's BugID ShellExec(Format('http://www.example.com/feedback.php?BugID=%s', [ExceptionInfo.BugIDStr])); end; procedure TMyExeptionDialogForm.SendAndTryClick(Sender: TObject); begin ModalResult := mrYes; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal Hide; end; procedure TMyExeptionDialogForm.TryButtonClick(Sender: TObject); begin ModalResult := mrOk; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal Hide; end; procedure TMyExeptionDialogForm.ExitButtonClick(Sender: TObject); begin TerminateProcess(GetCurrentProcess, ExceptionInfo.ExceptionCode); // Alternatively, you may try (see also above): // ModalResult := mrCancel; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal // Hide; end; procedure TMyExeptionDialogForm.CopyButtonClick(Sender: TObject); begin Clipboard.AsText := ListBox.Items.Text; // You may also try: // Dialog.CopyReportToClipboard; // <- copies full bug report into clipboard (in 2 forms: one as simple text, other is as file) // Clipboard.AsText := ExceptionInfo.CallStack.ToString; // <- copies call stack only end; procedure TMyExeptionDialogForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin // Don't forget to set the Form's KeyPreview property to true, or this won't trap the key if Key = VK_F1 then Application.HelpSystem.ShowTopicHelp('RefInternalError', Application.CurrentHelpFile); end; initialization // Register your dialog, so it can be used by EurekaLog RegisterDialogClass(TMyExeptionDialog); // Switch to your dialog CurrentEurekaLogOptions.ExceptionDialogType := TMyExeptionDialog.ClassName; // You may keep RegisterDialogClass in this unit, // but move chaging CurrentEurekaLogOptions.ExceptionDialogType somewhere else end. // Please note that dialog class have TONS of useful methods. Call them, don't be shy.