На форуме нашёл интересный способ обработать исключение из потока.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
TTestThread = class(TThread) private fEx : Exception; procedure QueryError; protected procedure Execute; override; end; procedure TTestThread .Execute; begin inherited; try ... всякое разное ... except fEx := ExceptObject as Exception; Synchronize( QueryError ); end; end; procedure TTestThread .QueryError; begin Application.OnException( Self, fEx ); end; |
Попробовал его в своей программе – и да, оно работает!
|
1 2 3 4 5 6 7 |
type TFTPUploadThread = class(TThread) private { Private declarations } fEx : Exception; |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
procedure TFTPUploadThread.Execute; var i: integer; zero:integer; begin // Будем делить на 0... try zero:=0; i:=1 div zero; except fEx := ExceptObject as Exception; Synchronize( QueryError ); end; end; |
|
1 2 3 4 5 6 |
procedure TFTPUploadThread.QueryError; begin Application.OnException(Self,fex); end; |
В основной программе бросил компонент ApplicationEvents и увидел следующее…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
procedure TVisualFrame.ApplicationEventsException(Sender: TObject; E: Exception); begin // On E : Exception do // raise Exception.Create(E.ClassName+' SomeError: ' // <<raise здесь не возбуждается, не знаю почему // +#13#10+#13#10+E.Message); if (Sender is TFTPUploadThread) then begin ShowMessage( (Sender as TFTPUploadThread).SourceFileName+#13#10+ 'Вызвана ошибка '+E.ClassName+'с сообщением : '+ E.Message ); end; end; |