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;

Answer 1

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;

Answer 2

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

Answer 3

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

Answer 4

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