スレッドをすぐに強制終了する ExitThread() を呼び出しています。これは、 CoUninitialize() 呼び出しが実行されなくなったことを意味します。自分で ExitThread を呼び出す必要はありません。スレッド関数を正常に終了するだけで十分です。
try
// ...
finally
CoUnintialize;
Result := 1; // the value that you specified in the ExitThread() call
end;
SuspendThread() を呼び出すと、スレッドが一時停止することがありますが、「finally」ブロックは実行されず、Calc() 関数から離れることも、スレッドを終了することもありません。スレッドが正常に終了できるように、Calc() 関数に「has-terminated」チェックを追加する必要があります。
編集:
これは、潜在的なタイムアウトを知るために Calc() メソッドを変更することにより、スレッドを正常に終了できるようにする疑似コードです。
type
ECalcTimedOut = class(Exception);
TSpAu = class(...)
protected
FCalcTimedOut: Boolean;
procedure CheckCalcTimedOut;
end;
PTeste = ^TTeste;
TTeste = record
ptrClass: TSpAu;
ptrTEMPO: ^integer;
end;
function THREAD_CALCULO(PTR: pointer): longint; stdcall;
begin
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
try
try
PTeste(PTR).ptrClass.Calc;
PTeste(PTR).ptrTEMPO^ := 1;
Result := 1;
except
on ECalcTimedOut do
Result := 0;
end;
finally
CoUninitialize;
end;
end;
procedure Calc_Prin;
var
TEMPO: integer;
RESULTADO: THandle;
thrID: DWord;
teste: TTeste;
begin
// ...
teste.ptrClass.FCalcTimedOut := False;
RESULTADO := CreateThread(nil, 0, @THREAD_CALCULO, @teste, 0, thrID);
if WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO) = WAIT_TIMEOUT then
begin
// Signal the Calc() method that it timed out
teste.ptrClass.FCalcTimedOut := True;
// Wait for the thread to terminate gracefully
WaitForSingleObject(RESULTADO, INFINITE);
end;
CloseHandle(RESULTADO);
end;
procedure TSpAu.CheckCalcTimedOut;
begin
if FCalcTimedOut then
raise ECalcTimedOut.Create('Calc Timed out');
end;
procedure TSpAu.Calc;
begin
CheckCalcTimeout;
// do something
while condition do
begin
CheckCalcTimeout;
DoSomethingElse;
CheckCalcTimeout;
// do something
end;
end;
procedure TSpAu.DoSomethingElse;
begin
for I := 0 to 1000000 do
begin
CheckCalcTimeout;
// do something
end;
end;