Root > Customizing EurekaLog > Coding > Subclassing

Subclassing

Previous pageReturn to chapter overviewNext page   

When event handlers are not enough, you need to override parts of EurekaLog's code to fulfill your needs. For example, if you want to alter icon in error dialogs or replace dialog as whole, if you want to change processing (exchange order of saving bug report and sending it), etc. or if you want to extend EurekaLog (like add new dialog or new send method) - then you can't use event handlers, because there is no event for that. But what you can do is to replace or extend EurekaLog's code with your own.

 

High level code of EurekaLog is done as classes. Therefore, if you need to alter minor point in EurekaLog (adjust it a little), then you may create your own class as child class to standard EurekaLog class, override some virtual method, write your own behavior code, call inherited method to get standard behavior, and so on. I.e. the usual things that you may do with tree of classes. Or you may write your own class completely from scratch (inheriting from base abstract class).

 

Note: please note that EurekaLog classes are constantly evolving (unlike events). There are new methods and features introduced as time passes. Therefore your code that uses sub-classing may need to be adjusted for new EurekaLog versions.

 

For that reason classes are described much less in documentation than other methods. Because they are used much rarely and changes more often. To study what you can do with classes you will have to read interface sections of units with declaration of classes. There you can see class inheritance, interesting methods to override, etc. You can do this even in EurekaLog's editions without full source code. We provide .pas headers for your reference (see "Source" folder of your EurekaLog installation).

 

The common rule is: if class can be only one (like log builder class), then class type is registered via global class variable. All you have to do is to write your own class and assign it to variable during initialization. Otherwise, if there may be various classes (like dialogs or send engines), then you have to create your own class, register it in global list via various RegisterSomething functions (they are declared in the same place as base abstract classes), and switch EurekaLog to use your class via options.

 

Let's see some code examples to make things clear.

 

 

Example #1: replacing dialog icon.

EurekaLog offers you feature to use generic error icon or icon of your application for error dialogs. However, you may want to use some other icon for that. There is no such feature in EurekaLog, but you can easily fix that with such code:

 

unit Unit1;
 
interface
 
// ...
 
implementation
 
uses
  EBase, ECore, EModules, EListView, EDialog, EDialogWinAPIMSClassic;
 
{$R *.dfm}
 
// To test our customization code
procedure TForm1.Button1Click(Sender: TObject);
begin
  raise Exception.Create('Error Message');
end;
 
type
  // Our child class - inheriting from standard TMSClassicDialog 
  TMSClassicDialogCustom = class(TMSClassicDialog)
  private
    FCustomIcon: HBITMAP; // our new icon
  protected 
    // Init/done:
    procedure WindowInit; override;
    procedure WindowDone; override;
    // Replacing icon drawing:
    function Paint(const ADC: HDC; const ARect: TRect): Integer; override;
  end;
 
{ TMSClassicDialogCustom }
 
procedure TMSClassicDialogCustom.WindowInit;
var
  Ico: HIcon;
begin
  inherited;
 
  Ico := LoadIcon(HInstance, 'CUSTOMICON');
  FCustomIcon := IcoToBmp(Ico, GetStockObject(WHITE_BRUSH), 32, 32);
end;
 
function TMSClassicDialogCustom.Paint(const ADC: HDC; const ARect: TRect): Integer;
begin
  Result := inherited;
  DrawBmp(ADC, FCustomIcon, MonitorLeft, MonitorTop, 32, 32);
end;
 
procedure TMSClassicDialogCustom.WindowDone;
begin
  DeleteObject(FCustomIcon);
  inherited;
end;
 
initialization
 
  if IsEurekaLogInstalled then
  begin
    // You have to register dialog before using it:
    RegisterDialogClass(TMSClassicDialogCustom);
    // Once registered - now you can use it in options:
    CurrentEurekaLogOptions.ExceptionDialogType := TMSClassicDialogCustom.ClassName;
  end;
 
end.

 

Obviously, this code replaces icon for one particular dialog type (MS Classic style). If you want to alter icon for several classes, then you have to write more your own child classes.

 

 

Example #2: replacing content of bug reports.

Recently we got a request from a customer. They use their own system to collect and sort bug reports generated by EurekaLog. Previously they worked with EurekaLog 6, but then upgraded to EurekaLog 7. Bug reports from EurekaLog 7 has slightly different structure than reports from EurekaLog 6 (new fields and columns). Therefore, new format of bug report file breaks their old code. Of course, they can update/improve their code or... switch EurekaLog to produce bug reports in old format. This can also be useful if you're migrating to EurekaLog from other exception tracers solutions (such as JCLDebug/JCLHookExcept, madExcept or Exception Magic). You can force EurekaLog to generate bug report in the format of your previous solution, so you won't have to re-write other code. Obviously, there is no such build-in feature in EurekaLog.

 

Here is a simple code that creates bug report in format of EurekaLog 6:

 

uses
  EConsts, ETypes, EClasses, ECallStack, EException, EEvents, ELogBuilder;
 
type
  // EurekaLog 6 format will be altered from default EurekaLog 7 format,
  // that's why we inherit from EurekaLog 7 builder class and 
  // replace only some methods
  TEurekaLog6Builder = class(TLogBuilder)
  public
    function CreateGeneralText: Stringoverride;
    function CreateCallStackText: Stringoverride;
  end;
 
{ TEurekaLog6Builder }
 
// Replace header of the bug report (to change "7" to "6" in header)
function TEurekaLog6Builder.CreateGeneralText: String;
begin
  Result := inherited;
  Result := 'EurekaLog 6' + Copy(Result, Pos(sLineBreak, Result), MaxInt);
end;
 
// Replace call stack (remove new columns)
function TEurekaLog6Builder.CreateCallStackText: String;
var
  Stack: TEurekaCallStack;
  Formatter: TEurekaBaseStackFormatter;
begin
  Stack := nil;
  try
    if CallStack <> nil then
    begin
      Stack := TEurekaCallStack.Create;
 
      Stack.Assign(CallStack);
 
      Stack.Formatter.Assign(Options);
      Stack.Formatter.CaptionHeader := 

        Options.CustomizedExpandedTexts[mtDialog_CallStackHeader] + EHeaderSuffix;
    end;
 
    Formatter := TEurekaStackFormatterV6.Create;
    try
      Formatter.Assign(Options);
      Formatter.CaptionHeader :=

        Options.CustomizedExpandedTexts[mtDialog_CallStackHeader] + EHeaderSuffix;
 
      Result := CallStackToString(Stack, 

        Options.CustomizedExpandedTexts[mtDialog_CallStackHeader] + EHeaderSuffix, 

        Formatter);
    finally
      FreeAndNil(Formatter);
    end;
  finally
    FreeAndNil(Stack);
  end;
end;
 
// Rename .el files to old .elf files
procedure CustomizeFileNames(const ACustom: Pointer; AExceptionInfo: TEurekaExceptionInfo; 

  const AFileType: TEurekaLogFileType; var AFileName: Stringvar ACallNextHandler: Boolean);
begin
  if AnsiLowerCase(ExtractFileExt(AFileName)) = '.el' then
    AFileName := ChangeFileExt(AFileName, '.elf');
end;
 
initialization
 
  // Register bug report builder:
  LogBuilderClass := TEurekaLog6Builder;
 
  // Register event handler for file names:
  RegisterEventCustomFileName(nil, CustomizeFileNames);
 
end.

 

This sample uses a combination of custom class and event handler to reach the desired goal.

 

 

Example #3: override original class.

Suppose that you want to alter original behavior/class, but don't want to create a new class (with new name), because this will require you to alter options as well. Instead, you want just to set up options at design time and provide altered behavior at run-time.

 

For example, when you post bug to Mantis, a issue title is composed. EurekaLog does not provide way to alter it, because it's used to identify tickets. You may want to alter it (say, by appending more info, so title becomes more descriptive). Here is how you can do that:

 

uses
  EConsts,
  ESend,
  ESendAPIMantis;
 
type
  // Trick: use the same class name as original class
  // You'll have to append unit name to class ident to avoid compiler confusion
  TELTrackerMantisSender = class(ESendAPIMantis.TELTrackerMantisSender)
  protected
    function ComposeTitle: Stringoverride;
  end;
 
// This is a default implementation of the method, 
// you can replace it with arbitrary code
function TELTrackerMantisSender.ComposeTitle: String;
begin
  if BugAppVersion <> '' then
    Result := Format('%s (Bug %s; v%s)', [BugType, BugID, BugAppVersion])   
  else
    Result := Format('%s (Bug %s)', [BugType, BugID]); 
  Log(Format('Title = ''%s''', [Result]));
end;
 
initialization
 
  // Register send class to be the first in the list.
  // Default class (by EurekaLog) will be listed later.
  // Any search for class by name will find our class, because it's listed first
  RegisterSenderFirst(TELTrackerMantisSender); // <- Notice "First" in the name
 
end.

 

With this trick you don't have to change options. You can just set options at design-time. The important part here is to register your class first, which is archived by using registering function with "First" suffix.

 

Note: please note that this is not recommended way to work with tickets in Mantis. We suggest you to create custom fields for your project (this is done in Mantis configuration). Fill custom fields with information (this is done in EurekaLog configuration). And show some of these fields in list of tickets (this is done in Mantis configuration). That way you will archive the desired effect (to see more info about each ticket in list), but also additionally gain some benefits: you will be able to sort/filter by custom fields, you will not break default EurekaLog tickets identification.

 

 

Example #4: a custom dialog.

You may be not satisfied by standard EurekaLog dialogs, so you may want to use your own dialog. Here is what you need to do: create class inheriting from abstract TBaseDialog class (EDialog unit), register it, and set ExceptionDialogType option. This example is similar to example #1. But this time we create dialog from scratch, we're not using ready classes.

 

The following sample shows four new dialog classes. Actually, this is just a code from EurekaLog itself, but it's short and simple to illustrate the point:

 

uses
  EDialog, EClasses, ETypes;
 
type
  // "Empty" dialog that does nothing at all
  TNullDialog = class(TBaseDialog)
  protected
    procedure Beep; override;
    function ShowModalInternal: TResponse; override;
  public
    class function ThreadSafe: Boolean; override;
  end;
 
  // MessageBox dialog
  TMessageBoxDialog = class(TBaseDialog)
  protected
    function ShowModalInternal: TResponse; override;
    procedure Beep; override;
  public
    class function ThreadSafe: Boolean; override;
  end;
 
  // A variant of MessageBox with more detailed message (with call stack)
  TMessageBoxDetailedDialog = class(TMessageBoxDialog)
  protected
    function ExceptionMessage: Stringoverride;
  end;
 
  // "Default" dialog - dialog that invokes standard dialog (non-EurekaLog)
  TRTLHandlerDialog = class(TBaseDialog)
  protected
    procedure Beep; override;
    function GetCallRTLExceptionEvent: Boolean; override;
    function ShowModalInternal: TResponse; override;
  end;
 
{ TNullDialog }
 
procedure TNullDialog.Beep;
begin
  // does nothing - no beep needed
end;
 
// Main method: do nothing, return success
function TNullDialog.ShowModalInternal: TResponse;
begin
  SetReproduceText(ReproduceText);
 
  Result.SendResult := srSent;
  Result.ErrorCode := ERROR_SUCCESS;
  Result.ErrorMessage := '';
end;
 
// Indicate that we can be called from any thread 

// (this should be False for VCL/CLX/FMX dialogs)
class function TNullDialog.ThreadSafe: Boolean;
begin
  Result := True;
end;
 
{ TMessageBoxDialog }
 
procedure TMessageBoxDialog.Beep;
begin
  // does nothing - beep is invoked by Windows.MessageBox in 

  // TMessageBoxDialog.ShowModalInternal
end;
 
// Main method 
function TMessageBoxDialog.ShowModalInternal: TResponse;
var
  Flags: Cardinal;
  Msg: String;
begin
  // Set default result
  Result.ErrorCode := ERROR_SUCCESS;
  Result.ErrorMessage := '';
  if SendErrorReportChecked then
    Result.SendResult := srSent
  else
    Result.SendResult := srCancelled;
 
  // Prepare message to show
  Msg := ExceptionMessage;
  if ShowSendErrorControl then
  begin
    Msg := Format(Options.CustomizedExpandedTexts[mtSend_AskSend], [Msg]);
    Flags := MB_YESNO;
  end
  else
    Flags := MB_OK;
  Flags := Flags or MB_ICONERROR or MB_TASKMODAL;
  if SendErrorReportChecked or (not ShowSendErrorControl) then
    Flags := Flags or MB_DEFBUTTON1
  else
    Flags := Flags or MB_DEFBUTTON2;
 
  // Call actual MessageBox and set result
  case MessageBox(Msg,
                  Options.CustomizedExpandedTexts[mtDialog_Caption],
                  Flags) of
    0: Result.ErrorCode := GetLastError;
    IDYes:
       Result.SendResult := srSent;
    IDNo:
       Result.SendResult := srCancelled;
  end;
 
  // Save error code/error message for failures
  if Result.ErrorCode <> ERROR_SUCCESS then
  begin
    Result.SendResult := srUnknownError;
    Result.ErrorMessage := SysErrorMessage(Result.ErrorCode);
  end
  else
    SetReproduceText(ReproduceText);
end;
 
// Can be called from any thread
class function TMessageBoxDialog.ThreadSafe: Boolean;
begin
  Result := True;
end;
 
{ TRTLHandlerDialog }
 
// Indicate desire to invoke RTL handler
function TRTLHandlerDialog.GetCallRTLExceptionEvent: Boolean;
begin
  Result := True;
end;
 
function TRTLHandlerDialog.ShowModalInternal: TResponse;
begin
  SetReproduceText(ReproduceText);
 
  Result.SendResult := srRestart;  // means "call RTL handler"
  Result.ErrorCode := ERROR_SUCCESS;
  Result.ErrorMessage := '';
end;
 
procedure TRTLHandlerDialog.Beep;
begin
  // Does nothing - transfer work to RTL handler
end;
 
{ TMessageBoxDetailedDialog }
 
// This one is a bit more complex - we want to add call stack to error message.
// However, default form is not very readable with variable-width fonts.
// That's why first we need a way to format call stack in another way.
 
type
  // Our new formatter
  TMessageBoxDetailedFormatter = class(TEurekaBaseStackFormatter)
  protected
    function GetItemText(const AIndex: Integer): Stringoverride;
    function GetStrings: TStrings; override;
  end;
 
// Forms one line of call stack
function TMessageBoxDetailedFormatter.GetItemText(const AIndex: Integer): String;
var
  Cache: TEurekaDebugInfo;
  Info: PEurekaDebugInfo;
  ModuleName, UnitName, RoutineName, LineInfo: String;
begin
  Info := CallStack.GetItem(AIndex, Cache);
 
  ModuleName := ExtractFileName(Info^.Location.ModuleName);
  UnitName := Info^.Location.UnitName;
 
  if UnitName = ChangeFileExt(ModuleName, ''then
    UnitName := ''
  else
    UnitName := '.' + UnitName;
 
  RoutineName := CallStack.ComposeName

    (Info^.Location.ClassName, Info^.Location.ProcedureName);
  if RoutineName <> '' then
    RoutineName := '.' + RoutineName;
 
  if Info^.Location.LineNumber > 0 then
    LineInfo := Format(',%d[%d]'

      [Info^.Location.LineNumber, Info^.Location.ProcOffsetLine]) 
  else
    LineInfo := '';
 
  Result := ModuleName + UnitName + RoutineName + LineInfo;
end;
 
// Formats entire call stack
function TMessageBoxDetailedFormatter.GetStrings: TStrings;
var
  ThreadID: Cardinal;
  I: Integer;
  Line: String;
  Stack: TEurekaBaseStackList;
begin
  if not Assigned(FStr) then
  begin
    FStr := TStringList.Create;
    FModified := True;
  end;
  if FModified then
  begin
    Stack := CallStack;
    CalculateLengths;
    FStr.BeginUpdate;
    try
      FStr.Clear;
      FStr.Capacity := Stack.Count;
 
      if Stack.Count > 0 then
      begin
        ThreadID := Stack.Items[0].ThreadID;
        for I := 0 to Stack.Count - 1 do
        begin
          if (Stack.Items[I].Location.Module <> 0) and
             (Stack.Items[I].Location.DebugDetail in [ddUnit..ddSourceCode]) and
             (Stack.Items[I].ThreadID = ThreadID) then
          begin
            Line := GetItemText(I);
            if (FStr.Count <= 0) or (FStr[FStr.Count - 1] <> Line) then
              FStr.Add(Line);
          end;
        end;
      end;
    finally
      FStr.EndUpdate;
    end;
    FModified := False;
  end;
  Result := FStr;
end;
 
// Append call stack to error message
function TMessageBoxDetailedDialog.ExceptionMessage: String;
const
  MaxLines = 15;
var
  Formatter: TMessageBoxDetailedFormatter;
  Stack: TEurekaBaseStackList;
begin
  {$WARNINGS OFF}
  // Abstract methods are intended here. 

  // It is like assert: they should not be called.
  Formatter := TMessageBoxDetailedFormatter.Create;
  {$WARNINGS ON}
  try
 
    if Assigned(CallStack) then
      Formatter.Assign(CallStack.Formatter);
    Formatter.CaptionHeader := '';
 
    Stack := nil;
    try
      if CallStack <> nil then
      begin
        Stack := TEurekaStackList.Create;
        Stack.Assign(CallStack);
        while Stack.Count > MaxLines do
          Stack.Delete(Stack.Count - 1);
      end;
      Result := inherited ExceptionMessage + sLineBreak + sLineBreak +
                CallStackToString(Stack, '', Formatter);
    finally
      FreeAndNil(Stack);
    end;
  finally
    FreeAndNil(Formatter);
  end;
end;

 

...

 

initialization

 

  RegisterDialogClass(TNullDialog);

  RegisterDialogClass(TMessageBoxDialog);

  RegisterDialogClass(TMessageBoxDetailedDialog);

  RegisterDialogClass(TRTLHandlerDialog);

 

end.

 

As you can see, the central method here is ShowModalInternal. It does all the work. It's abstract and must be overwritten in child classes. All other methods of TBaseDialog are virtual, but not abstract. They contain default behavior. You can override them to alter behavior, but you don't have to. Base dialog class contains large number of helpers (methods and properties). All that dialog needs to do is to invoke these methods in right order. Therefore any child class can use powerful tools to quickly build new dialog.

 

Note: there is another abstract dialog class - TWinAPIDialog from EDialogWinAPI unit. It's useful if you want to create new dialog based on direct WinAPI calls, rather than using ready functions or frameworks (VCL/CLX/FMX).

 

Important note: dialog class is responsible for almost whole exception processing. That's because "dialog" don't have to be visual. Think about Win32 service, system log, WER (Windows Error Reporting), etc. So, this is not always possible to distinguish between "error dialog" and "exception processing". That's why these concepts are both controlled by single "dialog" class. As we saw above, a major method for visual dialog is ShowModalInternal method. But real entry point is Execute method. Default implementation goes like this:

 

function TBaseDialog.Execute: TResponse;
var
  CanSaveReport: Boolean;
begin
  try
    SaveCurrentEnvironment;
    try
      SetupFileNames;
      FDuplicate := CalcDuplicatedException(FCanSend);
 
      if not Restarted then
      begin
        MakeScreenshot;
        AddCustomData;
        if DeleteLogAtVersionChange then
          DeleteOldLog;
        SetReproduceText('');
        if PresaveReport and SaveLogFile then
          SaveBugReport; // Pre-save to get log in case of crash in dialog
        Beep;
      end
      else
        FSaved := (PresaveReport and SaveLogFile);
      Result := ShowModal;
 
      // Restart dialog?
      if Result.SendResult = srRestart then
        Exit;
 
      // Save bug report
      CanSaveReport := SaveLogFile and
                       (
                         Succeeded(Ord(Result.SendResult)) or
                         (Result.SendResult = srCancelled) or
                         (not PresaveReport)
                       );
      if CanSaveReport then
        SaveBugReport; // Re-save to update changed fields (like reproduce text)
 
      if Succeeded(Ord(Result.SendResult)) and CanSend then
      begin
        PrepareFilesForSend;
 
        Result := SendBugReport;
 
        if Failed(Ord(Result.SendResult)) then
        begin
          if CopyLogInCaseOfError then
            CopyReportToClipboard;
          if SaveCompressedCopyInCaseOfError then
            SavePackedCopy;
        end
        else
        if DeleteLogAfterSuccessfulSend then
          DeleteCurrentLog;
 
        ShowSendResult(Result);
        if CanSaveReport then
          UpdateSendInformationInLog(Result.SendResult);
      end
      else
      begin
        DoEventExceptionAction(ExceptionInfo, atSendCancelled);
        if CanSaveReport then
          UpdateSendInformationInLog(srCancelled);
      end;
 
    finally
      RestoreCurrentEnvironment;
    end;
 
    CheckTermination;
    if Options.CustomFieldBool[difTerminateApplication] then
      TerminateApplication;
  except
    on E: Exception do
    begin
      Result.ErrorCode := ERROR_GEN_FAILURE;
      Result.ErrorMessage := E.Message;
      Result.SendResult := srUnknownError;
    end;
  end;
end;

 

As you can see, there is the whole processing of exceptions: saving bug report, displaying dialog, updating bug report with new values (e-mail/steps to reproduce), sending report, restarting application. You rarely need to alter this method, rather you will override methods which are called by it. This method is shown here just to illustrate the point that dialog controls more than just visual behavior.

 

As final words on sub-classing - here is the list of classes, units and functions for this (as of EurekaLog 7.0.02):

Base dialog class: EDialog.TBaseDialog.
Dialog class registration: EDialog.RegisterDialogClass.
Base send engine class: ESend.TELUniversalSender.
Send engine class registration: ESend.RegisterSender.
Base debug information provider class: EClasses.TELDebugInfoSource.
Debug information provider registration: EDebugInfo.RegisterDebugInfoSource.
Base call stack class: ECallStack.TEurekaBaseStackList.
Default call stack class: ECallStack.EurekaCallStackClass.
Specific call stack classes: ECallStack.TracerMethodsClasses.
Base log builder class: ELogBuilder.TBaseLogBuilder.
Default log builder class: ELogBuilder.LogBuilderClass.
Base hung detection thread class: EFreeze.TFreezeThread.
Default hung detection thread class: EFreeze.FreezeThreadClass.

 

 

See also:




Send feedback... Build date: 2023-09-11
Last edited: 2023-03-07
PRIVACY STATEMENT
The documentation team uses the feedback submitted to improve the EurekaLog documentation. We do not use your e-mail address for any other purpose. We will remove your e-mail address from our system after the issue you are reporting has been resolved. While we are working to resolve this issue, we may send you an e-mail message to request more information about your feedback. After the issues have been addressed, we may send you an email message to let you know that your feedback has been addressed.


Permanent link to this article: https://www.eurekalog.com/help/eurekalog/customizing_subclassing.php