3

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

4 に答える 4

2

このメッセージ ボックス( のラッパー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;

スクリーンショット

于 2012-04-18T15:23:07.080 に答える
1

メッセージ ダイアログ (および例外ダイアログ) はモーダルであるため、最初の TakeScreenShotAndSaveInApplicationFolder 呼び出しは表示される前に実行され、2 番目の呼び出しは閉じられるまで実行されません。

表示ルーチンの一部として画面をキャプチャする独自のメッセージ ダイアログを作成することもできますが、顧客が何を求めているかではなく、何を望んでいるかを見て、より良い解決策を見つけることをお勧めします。

その音から、エラー発生時にアプリケーションがどのような状態であったかを正確に確認できるようにしたいと考えています。これは、スクリーングラブ + エラーの詳細を意味します。なぜエラーの詳細をスクリーングラブの一部にする必要があるのか​​ わかりません。

サード パーティのエラー ログ システム (MadExcept、JclDebug) の使用を検討し、それを拡張して、エラー メッセージのないアプリケーションのスクリーンショットをキャプチャしてみませんか?

これにより、エラーダイアログが表示されたときにスクリーンショットを作成するという頭痛の種なしに、同じくらい多くの情報が得られます (例外ログが生成できる追加情報により、より多くの情報が得られます)。

また、デスクトップ画面全体をつかむことにも疑問があります。バックグラウンド ウィンドウで機密情報を誤って取得する傾向があります。

参照リンク:

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

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

于 2012-04-18T12:30:54.460 に答える
1

独自のカスタム フォームを使用してエラー ダイアログを表示し、そのフォームでスクリーンショットの撮影を制御できるようにします。

于 2012-04-18T14:56:47.357 に答える
0

@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

于 2012-04-20T06:50:39.877 に答える