EurekaLogでスレッドの例外を受け取る
EurekaLogで別スレッドで発生した例外を受け取る方法としては、公式Documentにいろいろと書いてあります。
公式ドキュメント サンプルソースの罠
で、まずあるのが
type TMyThread = class(TThreadEx) protected procedure Execute; override; end; procedure TMyThread.Execute; begin // ... your code ... end; procedure TForm1.Button1Click(Sender: TObject); var Thread: TMyThread; E: TObject; begin // Create thread Thread := TMyThread.Create('Thread Name'); try // Wait for threads completion. // This wait can be implemented in any other way. // E.g. you can assign OnTerminate handler; // or you can PostMessage from thread to main thread. Thread.WaitFor; // Analyze thread completion. // Re-raise any thread error in current thread. // You should do this only after the thread has finished. E := Thread.FatalException; if Assigned(E) then begin // clear FatalException property PPointer(@Thread.FatalException)^ := nil; raise E; end; finally FreeAndNil(Thread); end; end;
まぁ、ぱっと見でこれを使うのはありえないなって感じですよね。
メインスレッド側でWaitFor使ってスレッドの終了を待機しています。これじゃスレッド使う意味がないので、実用性もないです。
で、次に出てくるのがこれ
type TMyThread = class(TThreadEx) protected procedure Execute; override; end; procedure TMyThread.Execute; begin // ... your code ... end; procedure TForm1.Button1Click(Sender: TObject); var Thread: TMyThread; begin Thread := TMyThread.Create(True, 'My thread'); Thread.AutoHandleException := True; // <- added Thread.FreeOnTerminate := True; Thread.Start; Thread := nil; // never access thread var with FreeOnTerminate after Start end;
これだと、メインスレッドを止めることなくスレッド側の例外通知を受け取れます。
とはいってもこれも問題で、Thread.StartのあとにThreadのポインタをnilにしちゃってることです。
コメントにも書いてありますが「二度とアクセスするな」と。。。なんじゃそら。
スレッド自体はFreeOnTerminateで自動的に終了するようですが、これだとスレッドの現在の状況とかわからないし、こっちも結構不便です。
例外発生して終了していた場合、OnTerminateも発生しなかったので終了検知ができないわけです。
こっちとしては、今まで通りスレッドへのアクセスもしたいわけですし、それでいて例外通知も処理したいと。
で、どうするのか。。。
自作クラスで対応
というわけで、こんな感じのを作りました。
以前TThreadから派生したTTscThreadというのは作っていたので、それに近い形で実装したものが以下。
unit TsuThreadEx; interface uses System.Classes, System.Generics.Collections, System.SysUtils, ExceptionLog7, EBase, EInject, EException, EEvents ; type TTsrThreadCallBacks = object OnExecute : TNotifyEvent; OnTerminate : TNotifyEvent; OnTerminating : TNotifyEvent; OnThreadLoop : TNotifyEvent; procedure Clear; end; TTscThreadEx = class(TThreadEx) private FLoopBreak : Boolean; FOnExecute : TNotifyEvent; FOnTerminating : TNotifyEvent; FOnThreadLoop : TNotifyEvent; protected procedure Execute;override; procedure Initialize;virtual; procedure ThreadMain;virtual; procedure DeInitialize;virtual; public constructor Create(callbacks:TTsrThreadCallBacks); property OnTerminate; property OnExecute : TNotifyEvent read FOnExecute write FOnExecute; property OnTerminating : TNotifyEvent read FOnTerminating write FOnTerminating; property LoopBreak : Boolean read FLoopBreak write FloopBreak; property OnThreadLoop : TNotifyEvent read FOnThreadLoop write FOnThreadLoop; property Terminated; end; TTscThreadExCtrl = class(TObject) private function GetFinished:Boolean; protected FThread : TTscThreadEx; FOnTerminate : TNotifyEvent; FActive : Boolean; FCallBacks : TTsrThreadCallBacks; procedure Terminate; procedure ThreadFree; procedure ExecuteThread;virtual;abstract; procedure ThreadOnTerminate(Sender:TObject); public constructor Create; destructor Destroy;override; procedure SetUp(callbacks:TTsrThreadCallBacks; params:Pointer);virtual; procedure Execute; procedure TerminateAndNil; procedure ExceptProcEvent(AExceptionInfo: TEurekaExceptionInfo; var AHandle: Boolean; var ACallNextHandler: Boolean); property OnTerminate : TNotifyEvent read FOnTerminate write FOnTerminate; property Active : Boolean read FActive; property Finished : Boolean read GetFinished; end; implementation procedure TTsrThreadCallBacks.Clear; begin OnExecute := nil; OnTerminate := nil; OnTerminating := nil; OnThreadLoop := nil; end; {$region' TTscThreadEx '} constructor TTscThreadEx.Create(callbacks:TTsrThreadCallBacks); begin FLoopBreak := False; AutoHandleException := True; FreeOnTerminate := True; OnTerminate := callbacks.OnTerminate; FOnExecute := callbacks.OnExecute; FOnTerminating := callbacks.OnTerminating; FOnThreadLoop := callbacks.OnThreadLoop; inherited Create(True, ClassName); end; procedure TTscThreadEx.Execute; begin if Assigned(OnExecute) then OnExecute(Self); Initialize; while not Terminated do begin if Assigned(OnThreadLoop) then OnThreadLoop(Self); ThreadMain; if LoopBreak then Break; end; if Assigned(OnTerminating) then OnTerminating(Self); DeInitialize; if Assigned(OnTerminate) then OnTerminate(Self); end; procedure TTscThreadEx.Initialize; begin end; procedure TTscThreadEx.ThreadMain; begin end; procedure TTscThreadEx.DeInitialize; begin end; {$endregion} {$region' TTscThreadExCtrl '} constructor TTscThreadExCtrl.Create; begin FThread := nil; RegisterEventExceptionNotify(ExceptProcEvent, False); inherited Create; end; destructor TTscThreadExCtrl.Destroy; begin if FThread <> nil then FreeAndNil(FThread); inherited Destroy; end; procedure TTscThreadExCtrl.Execute; begin if not Assigned(FThread) then begin ExecuteThread; FThread.Start; FActive := True; end; end; procedure TTscThreadExCtrl.Terminate; begin if Assigned(FThread) then if not FThread.Finished then FThread.Terminate; if Assigned(FOnTerminate) then FOnTerminate(Self); FActive := False; end; procedure TTscThreadExCtrl.ThreadFree; begin FThread := nil; end; procedure TTscThreadExCtrl.SetUp(callbacks:TTsrThreadCallBacks; params:Pointer); begin FCallBacks := callbacks; FOnTerminate := callbacks.OnTerminate; callbacks.OnTerminate := ThreadOnTerminate; end; procedure TTscThreadExCtrl.ThreadOnTerminate(Sender: TObject); begin end; function TTscThreadExCtrl.GetFinished: Boolean; begin if Assigned(FThread) then Result := FThread.Finished else Result := True; end; procedure TTscThreadExCtrl.TerminateAndNil; begin Terminate; ThreadFree; end; procedure TTscThreadExCtrl.ExceptProcEvent(AExceptionInfo: TEurekaExceptionInfo; var AHandle: Boolean; var ACallNextHandler: Boolean); begin if Assigned(FThread) then begin if AExceptionInfo.ThreadID = FThread.ThreadID then TerminateAndNil; end; end; {$endregion}
はい。
で、ポイントはTTscThreadExCtrlクラス。これはTTscThreadExクラスから派生したスレッドの管理をするクラスです。
これのCreateで
RegisterEventExceptionNotify(ExceptProcEvent, False);
と書いてますが、これを書くことでEurekaLogが例外を受け取った際に発生させてくれるイベントに登録ができます。
登録したのはExceptProcEventメソッドです。
これの中身は、TTscThreadExCtrlが管理しているスレッドと、イベント引数のAExceptionInfo.ThreadIDとを比較しています。これが一致した場合は、管理下のスレッドから例外が発生しているということなので、スレッドの終了処理に移行する。という流れ。
公式Documentにあったthread := nilはせずにいるので、こちらで破棄するまでアクセス可能です。
あとはこれらを派生させたクラスをベースにコーディングすればスレッド周りはとりあえず問題なく動いています。
EurekaLogは設定まわりもちょいと面倒だったのでいつか書き残そうかと。
ディスカッション
コメント一覧
まだ、コメントがありません