Geek asks and answers

Delphi screen capture in global exception

I am working on a component using Delphi 2006, the component extracts system information and writes to a file. The requirement is that I have to include a global exception handler in the component, so when an exception occurs, it will be caught and the user 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 as required, I have to capture the image with an error (this will visually display the form in which the exception occurred)

So, I did this using the 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 an exception occurs, I want to take a screenshot of the message, but with my code this will happen

enter image description here

- , ?

enter image description here

MessageDlg('Exception has Occured, Detail ' + E.Message,mtError,[mbOK],0); , . , , , ?

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;
+3
4

( Windows.MessageBox) :

{ 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;

:

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;

Screen shot

+2

( ) , TakeScreenShotAndSaveInApplicationFolder , , .

, . , , , , , .

, . , screengrab +, , screengrab .

(MadExcept, JclDebug) , ?

( , - , ), .

, . .

:

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

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

+1

, , .

+1

, , @NGLN ( ) @Pieter B . Open-Source-SynTaskDialog, ,

 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;

SynTaskDialog.pas

          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;

enter image description here

button click onshow,

0

More articles:


All Articles