线程中的异常处理

Posted 2021-02-13 kinglandsoft

// Quelle: http://edn.embarcadero.com/article/10452

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TMyThread = class(TThread)
  private
    FException: Exception;
    procedure DoHandleException;
  protected
    procedure Execute; override;
    procedure HandleException; virtual;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  // Create an instance of the TMyThread
  with TMyThread.Create(True) do
  begin
    FreeOnTerminate := True;
    Resume; 
  end;
end;

{ TMyThread }

procedure TMyThread.DoHandleException;
begin
  // Cancel the mouse capture
  if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  // Now actually show the exception
  if FException is Exception then
    Application.ShowException(FException)
  else
    SysUtils.ShowException(FException, nil);
end;

procedure TMyThread.Execute;
var
  a: Integer;
  b: Integer;
begin
  inherited;
  FException := nil;
  try
    // raise an Exception
    b := 0;
    a := 42 div b;
    Messagebox(0, PansiChar(IntToStr(a)), ‘fehler‘, 0)
    //raise Exception.Create(‘I raised an exception‘);
  except
    HandleException;
  end;
end;

procedure TMyThread.HandleException;
begin
  // This function is virtual so you can override it
  // and add your own functionality.
  FException := Exception(ExceptObject);
  try
    // Don‘t show EAbort messages
    if not (FException is EAbort) then
      Synchronize(DoHandleException);
  finally
    FException := nil;
  end;

end;

end.