delphi screen capture in global exception - delphi

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