Сегодня закончил тестирование обновления для модуля TasksEx. Не считая служебных, в него должны были войти такие функции:
// Raises EExternalAbort in last launched worker thread
procedure AbortLastWorkerThread;
// Raises EExternalAbort in all worker threads
procedure AbortAllWorkerThreads;
// Raises EExternalAbort in specific worker thread.
(*
Handle of worker thread can be obtained by call to GetCurrentThreadHandle inside of Enter/LeaveWorkerThread block, thread function of Execute method.
AbortWorkerThread(THandle) differs from _RaiseAbortInThread(THandle).
AbortWorkerThread raises exception only when user code is executed in the thread (for external threads - code between RegisterAsWorkerThread/UnregisterAsWorkerThread). I.e. - it is safe.
*)
procedure AbortWorkerThread(const AThreadHandle: THandle);
// These functions can not interrupt kernel code.
// Registers any thread (TThread, CreateThread, etc) as worker thread.
// Once registered you can abort it with AbortXXX functions above.
procedure RegisterAsWorkerThread(const AThreadHandle: THandle);
procedure UnregisterAsWorkerThread(const AThreadHandle: THandle);
// Returns real handle of current thread
function GetCurrentThreadHandle: THandle;
Смысл в том, чтобы рабочий поток мог бы выполняться, не проверяя флагов отмены потока. А из гуёвого потока можно было бы вызвать функцию отмены работы (см. выше). Функция отмены возбудила бы в рабочем потоке исключение (класса EAbort) и, таким образом, отменила бы поток.
Хотя само возбуждение исключения во внешнем потоке мне удалось сделать без особых проблем, но оказалось, что нельзя возбуждать его в любое время.
Посмотрите на такой (типичный) код:
F := TF.Create;
try
// do something with F
finally
FreeAndNil(F);
end;
Что будет, если исключение возникнет в процессе выполнения деструктора F? Или сразу после выхода из конструктора, но до установки try? Ничего хорошего: утечка ресурсов будет.
Увы, но такой красивый механизм себя не оправдал. Хотя я не собираюсь специально искать решения этих проблем, но, может быть, другой механизм или решение этой проблемы когда-нибудь само придёт ко мне в голову :)
P.S.
Если кому интересно, таким был основной код:
{ EExternalAbort }
class function EExternalAbort.Create: EExternalAbort;
begin
Result := inherited Create('');
end;
// $W- (in unit's header) has the same effect
{$STACKFRAMES OFF}
procedure RaiseExternalAbort;
begin
raise EExternalAbort.Create;
end;
procedure _RaiseAbortInThread(AThreadHandle: THandle); overload;
var
Context: Windows.TContext;
begin
try
FillChar(Context, SizeOf(Context), 0);
Context.ContextFlags := CONTEXT_CONTROL;
if SuspendThread(AThreadHandle) = DWORD(-1) then
RaiseLastOSError;
try
if not GetThreadContext(AThreadHandle, Context) then
RaiseLastOSError;
Context.Eip := DWord(@RaiseExternalAbort);
if not SetThreadContext(AThreadHandle, Context) then
RaiseLastOSError;
finally
if ResumeThread(AThreadHandle) = DWORD(-1) then
RaiseLastOSError;
end;
except
on E: Exception do
raise EAbortRaiseError.CreateFmt(RsErrorRaisingAbortExcep, [E.Message]);
end;
end;
См. также - раздел "Оффтопик на тему".
ОтветитьУдалить