0

所以，我已经使用 THandle 实现了线程，就像这样：

procedure Calc_Prin;
type
  TTeste = record
    ptrClass: TSpAu;
    ptrTEMPO: ^integer;
  end;

var
  TEMPO: integer;
  RESULTADO: THandle;
  thrID: DWord;
  teste: TTeste;

  function THREAD_C(PTR: pointer): longint; stdcall;
  begin
    try
      CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
      TPtrTeste(PTR).ptrClass.Calc;
      TPtrTeste(PTR).ptrTEMPO^ := 1;
    finally
      ExitThread(1);
      CoUninitialize;
      result := 0;
    end;
  end;

begin
  RESULTADO := CreateThread(nil, 0, @THREAD_C, @teste, 0, thrID);
  WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO); 

  SuspendThread(RESULTADO);
  CloseHandle(RESULTADO);
end;

当线程正常时（没有达到超时并且进程没有提前结束）没有任何泄漏，但是如果线程有问题并达到超时，它会给我很多泄漏，因为，我猜猜，它只是离开了函数，忽略了所有的尝试......最后我释放了所有东西。

有没有办法完成线程，并杀死它允许的泄漏？

4

2 回答 2

2

您正在调用 ExitThread() 立即杀死线程这意味着 CoUninitialize() 调用不再执行。您不需要自己调用 ExitThread。正常退出线程功能就足够了。

try
  // ...
finally
  CoUnintialize;
  Result := 1; // the value that you specified in the ExitThread() call
end;

调用 SuspendThread() 可能会暂停线程，但不会执行“finally”块，也不会离开 Calc() 函数，也不会终止线程。您需要在 Calc() 函数中添加“已终止”检查，以便线程可以正常终止。

编辑：
这是一个伪代码，它允许您的线程通过更改 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;
于 2014-09-26T19:27:50.563 回答
0

尝试更多类似的东西：

type
  TSpAu = class
  public
    Cancelled: Boolean;
    procedure Calc;
  end;

  TPtrTeste = ^TTeste;
   TTeste = record
    ptrClass: TSpAu;
    ptrTEMPO: ^integer;
  end;

procedure TSpAu.Calc;
begin
  ...
  if Cancelled then Abort;
  ...
  if Cancelled then Abort;
  ...
end;


function THREAD_CALCULO(PTR: pointer): DWORD; stdcall;
begin
  CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
  try
    with TPtrTeste(PTR)^ do
    begin
      try
        ptrClass.Calc;
        ptrTEMPO^ := 1;
      except
        ptrTEMPO^ := 0;
      end;
    end;
  finally
    CoUninitialize;
  end;
  Result := 0;
end;

procedure Calc_Prin;
var
  TEMPO: integer;
  RESULTADO: THandle;
  thrID: DWord;
  teste: TTeste;
  ret: DWORD;
begin
  TEMPO := 0;

  teste.ptrClass := ...; // <-- whatever your TSpAu object is
  teste.ptrTEMPO := @TEMPO;

  RESULTADO := CreateThread(nil, 0, @THREAD_CALCULO, @teste, 0, thrID);
  if RESULTADO = 0 then RaiseLastOSError;
  try
    ret := WaitForSingleObject(RESULTADO, TEMPO_PERMITIDO);
    if ret = WAIT_TIMEOUT then
    begin
      teste.ptrClass.Cancelled := True;
      ret := WaitForSingleObject(RESULTADO, INFINITE);
    end;
    if ret = WAIT_FAILED then RaiseLastOSError;
  finally
    CloseHandle(RESULTADO);
  end;

  // use TEMPO as needed...
end;
于 2014-09-26T20:11:30.683 回答