Question

我正在使用一个组件使用Delphi 2006 ，该组件检索系统信息并写入文件。要求是我必须在组件中包含一个全局异常处理程序，所以当异常发生时它将被捕获并且我的自定义消息将显示给用户。

  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;

这样可以正常工作但是根据要求我必须捕获错误屏幕截图（这是在视觉上找到弹出异常的表单）

所以我这样做了，从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;

问题：

当异常发生时，我想拍摄消息的屏幕截图，但是我的代码会发生这种情况

谁能告诉我如何才能获得这样的屏幕截图？这是沿着表格获取消息

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;

Answer 1

修改this message box（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;

Answer 2

消息对话框（和异常对话框）是模态的，因此第一个TakeScreenShotAndSaveInApplicationFolder调用将在显示之前执行，第二个将在关闭之后才会执行。

您可以创建自己的消息对话框，该对话框会将屏幕捕获为其显示例程的一部分，但我建议您应该查看客户想要的内容，而不是他们要求的内容并获得更好的解决方案。

从它的声音中，他们希望能够确切地看到错误发生时应用程序处于什么状态。这意味着screengrab +错误细节，我不明白为什么错误细节需要特别成为screengrab的一部分。

为什么不考虑使用第三方错误记录系统（MadExcept，JclDebug）并将其扩展为捕获应用程序的屏幕截图而不显示错误消息？

这将为您提供尽可能多的信息（更多，由于异常日志可以产生的额外信息），而不必担心在引发错误对话框时屏蔽错误对话框。

另外，我会质疑抓住整个桌面屏幕。它很容易无意中在背景窗口上抓取敏感信息。

参考链接：

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

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

Answer 3

使用您自己的自定义表单显示错误对话框，并让该表单控制屏幕截图。

Answer 4

我通过@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;

我在button click做了onshow，快照只有一半

delphi屏幕捕获全局异常

4 个答案: