delphi screen capture in global exception

Question

I am working on a component, using Delphi 2006, the component retrieves system information and writes to file. The requirement is such that I have to incorporate a global exception handler in the component, so when the exception occurs it will be caught and my custom message will be shown to the user.

  procedure Tmy.GlobalExceptionHandlerThis(Sender : TObject; E : Exception );
  begin
    //catch the exception and show the message
      TakeScreenShotAndSaveInapplicationFolder;
      MessageDlg('Exception has Occured  , Detail  '+E.Message,mtError,[mbOK],0);
  end;

This works fine but according to the requirement I have to capture the errorscreen shot (This is to find visually the form where the exception popped up)

So I did this, with take screenshot code from delphigeist.com:

procedure TakeScreenShotAndSaveInapplicationFolder;
var
  thisBitmap: TBitmap;
  sDate : string;
begin
  DateSeparator :='_';
  TimeSeparator:='_';
  sDate :=DateTimeToStr(now);
  thisBitmap := TBitmap.Create;
  ScreenshotArea(thisBitmap, Screen.DesktopRect, True);
  thisBitmap.SaveToFile(ExtractFilePath(Application.ExeName)+sDate+'.jpg');
  FreeAndNil(thisBitmap);
end;

Problem:

When the exception occurs, I want to take the screen shot of the message also but with my code the this happens

Can anyone tell me how I can get the screen shot like this? That is along the form get the message

MessageDlg('Exception has Occured, Detail ' + E.Message,mtError,[mbOK],0); is modal, so after the message I can't take the screen shot. And before I can't also, so when can I take the screen shot right when the exception message is displayed?

procedure Tmy.GlobalExceptionHandlerThis(Sender : TObject; E : Exception );
begin
  //catch the exception and show the message
  TakeScreenShotAndSaveInapplicationFolder;
  MessageDlg('Exception has Occured  , Detail  '+E.Message,mtError,[mbOK],0);
  TakeScreenShotAndSaveInapplicationFolder;
end;

A screenshot alone is rather feeble. What you really want is a stack dump and more. You want madExcept. — David Heffernan, Apr 18 '12 at 17:13
@DavidHeffernan the stack dump, is nice idea, i will try that also along with the screenshot — PresleyDias, Apr 19 '12 at 04:08

score 2 · Accepted Answer · edited May 23 '17 at 12:33

Modify this message box (a wrapper around Windows.MessageBox), as follows:

{ TAwMessageBox }

type
  TAwMessageBox = class(TObject)
  private
    FCaption: String;
    FFlags: Cardinal;
    FHookProc: TFarProc;
    FText: String;
    FWndHook: HHOOK;
    function Execute: Integer;
    procedure HookProc(var Message: THookMessage);
  end;

function TAwMessageBox.Execute: Integer;
begin
  try
    try
      FHookProc := MakeHookInstance(HookProc);
      FWndHook := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, 0,
        GetCurrentThreadID);
      Result := Application.MessageBox(PChar(FText), PChar(FCaption), FFlags);
    finally
      if FWndHook <> 0 then
        UnhookWindowsHookEx(FWndHook);
      if FHookProc <> nil then
        FreeHookInstance(FHookProc);
    end;
  except
    Result := 0;
  end;
end;

procedure TAwMessageBox.HookProc(var Message: THookMessage);
var
  Data: PCWPRetStruct;
  Title: array[0..255] of Char;
begin
  with Message do
    if nCode < 0 then
      Result := CallNextHookEx(FWndHook, nCode, wParam, lParam)
    else
      Result := 0;
  if Message.nCode = HC_ACTION then
  begin
    Data := PCWPRetStruct(Message.lParam);
    if (Data.message = WM_ACTIVATE) and (LoWord(Data.wParam) = WA_INACTIVE) then
    begin
      ZeroMemory(@Title, SizeOf(Title));
      GetWindowText(Data.hwnd, @Title, SizeOf(Title));
      if String(Title) = FCaption then
      begin
        TakeScreenShotAndSaveInapplicationFolder;
        UnhookWindowsHookEx(FWndHook);
        FWndHook := 0;
        FreeHookInstance(FHookProc);
        FHookProc := nil;
      end;
    end;
  end;
end;

function MsgBox(const Text: String; Flags: Cardinal;
  const Caption: String): Integer;
begin
  with TAwMessageBox.Create do
  try
    FCaption := Caption;
    FFlags := Flags;
    FText := Text;
    Result := Execute;
  finally
    Free;
  end;
end;

Testing code and screen shot:

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
  MsgBox('Exception has occured. Details:'#13#10#13#10 + E.Message,
    MB_OK or MB_ICONERROR, 'Error');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  raise Exception.Create('Test exception');
end;

+1, getting `[Error] u_home.pas(54): Undeclared identifier: 'THookMessage` for ` procedure HookProc(var Message: THookMessage); ` — PresleyDias, Apr 19 '12 at 04:24

score 1 · Answer 2 · answered Apr 18 '12 at 12:30

1

Message dialogs (and exception dialogs) are modal so the first TakeScreenShotAndSaveInApplicationFolder call will execute before it displays and the second will not execute until after it has closed.

You could create your own message dialog which captures the screen as part of it's Show routine, but I'd suggest that you should look at what the customer wants, rather than what they have asked for and get a better solution.

From the sounds of it, they want to be able to see exactly what state the application was in at the time of the error. This means screengrab + error details, and I don't see why the error details need to be part of the screengrab specifically.

Why don't you look at using a 3rd party error logging system (MadExcept, JclDebug) and extend it to capture a screenshot of the application without the error message?

This would give you just as much information (more, due to the additional info that the exception logs can produce), without the headache of trying to screenshot error dialogs when they're raised.

Also, I'd question grabbing the entire desktop screen. It's prone to inadvertently grabbing sensitive information on background windows.

Reference Links:

Jcl - http://sourceforge.net/projects/jcl/

MadExcept - http://madshi.net/madExceptDescription.htm

answered Apr 18 '12 at 12:30

JamesT

2,988
23
29

1

MadExcept has an option for capturing screen shot, either the application or entire screen. The screen shot is attached to a bugreport email. I do not see an option to save the screen shot to a file. – crefird Apr 18 '12 at 12:43
I use JclDebug rather than MadExcept so I didn't know that. Nice feature! Might solve all of his requirements in one fell swoop. – JamesT Apr 18 '12 at 12:47
1

@crefird, MadExcept exposes the screenshot as a property of the IMEException interface. If you register a BugReportCallback you can get hands on it and save the screenshot as BMP or PNG. – Uwe Raabe Apr 18 '12 at 12:55
@UweRaabe, that is good to know. I have been satisfied with the sceeen shot attached to the bugreport email, because the bugrepot emails allow me to maintain a history of unhandled exceptions with very little effort. – crefird Apr 18 '12 at 13:47
I also recommend EurekaLog, for anyone considering MadExcept. – Chris Thornton Apr 18 '12 at 20:16

score 1 · Answer 3 · answered Apr 18 '12 at 14:56

1

Use your own custom form to show the error dialog and let that form control the screenshottaking.

answered Apr 18 '12 at 14:56

Pieter B

1,874
10
22

ok but how to create a form inside a component and display is on exception? – PresleyDias Apr 19 '12 at 04:35
Make a new form in your application but be sure to remove it from the autocreate in your project settings and give it a name: MyExceptionBox. Might need to add that unit to your uses. Now make a function that creates and displays the form: MyExceptionDlg. Create it like this: var MyExceptionBox:TMExceptionBox; begin MyExceptionBox:=TMyExceptionBox.Create(self); try MyExceptionBox.Showmodal; finally MyExceptionBox.Free; End; Now Instead of calling MessageDlg in your except call MyExceptionDlg, done. (or you could rightclick MessageDlg and click: find declaration) – Pieter B Apr 19 '12 at 06:53

score 0 · Answer 4 · edited Apr 20 '12 at 08:56

i managed to get what i wanted, after going through @NGLN idea(answer above),and @Pieter B idea for taking screen shot by the form itself.. so i used the Open-Source-SynTaskDialog to display my exception message like this

 procedure Tmy.GlobalExceptionHandlerThis(Sender : TObject; E : Exception );
   begin
    var Task: TTaskDialog;
       begin
          Task.Title:='Error message';
          Task.Inst := 'An error/exception has occured';
          Task.Content := 'the details are ...';
          Task.Execute([],0,[],tiError ,tfiShield ,200);
       end;

And inside the SynTaskDialog.pas i did this

          procedure TTaskDialogForm.ButtonClick(Sender: TObject);
            begin

           TakeScreenShotAndSaveInapplicationFolder; {<--take the snap shot here..!!!}
          if (Sender<>nil) and Sender.InheritsFrom(TSynButton) then
          with TSynButton(Sender) do begin
          self.Tag := Tag;
          if Tag in [mrOk..mrNo] then
          self.ModalResult := Tag;
          Close;
         end;
        end;

this i did on button click as onshow the the snap shot was only half

delphi screen capture in global exception

4 Answers4

Linked