Delphi TIdTcpServer在someTimeOut之后强制停止IdSync

Question

我需要使用Indy和Delphi XE2开发具有持久连接的TCP服务器和客户端。 几乎一切进展顺利。

此服务是一项关键服务，因此我需要在服务器中加入一些保护，以防止不必要的处理或冻结。 因此，我创建了一个线程来检查关键进程的超时。

我做了这个TIdSync类：

type
  TSync = class(TIdSync)
  protected
    procedure DoSynchronize; override;
  end;

procedure TSync.DoSynchronize;
var
  oTimeOut: TThreadTimeOut;
begin
  ...
  oTimeOut := TThreadTimeOut.Create(AContext, WaitTimeOut*2, Self);
  oTimeOut.Start;
  ...
  // the code below is just a test, **this is the key to my question**
  // if something goes wrong in any subroutine of DoSynchronize, I want
  // to stop execution of this object and destroy it. In the thread above
  // I want to test when the timeout elapses. If this IdSync object still
  // exists and if this routine is still executing, I want to stop execution
  // of any routine or subroutine of this object to avoid freezing the
  // service and stop memory consumption and CPU usage

  while true do begin
    Sleep(100);
  end;

  //If everything is OK
  oTimeOut.Stop;
end;

procedure TThreadTimeOut.execute;
var
  IniTime: DWORD;
begin
  IniTime := GetTickCount;
  while GetTickCount < IniTime + TimeOut  do begin
    Sleep(SleepInterval);
    if StopTimeOut then
       Exit;
  end;

  if ((Terminated = False) or (StopTimeOut)) and (IoHandler <> nil)  then begin
    IOHandler.Connection.IOHandler.Close;
    IdSync.Free; //here I try to make things stop execution but the loop to test is still running
  end;
end;

上面的这段代码可以很好地用于在超时后停止接收和发送数据，但是不能停止执行TIdSync 。 我怎样才能做到这一点？

Answer 1

TIdSync没有超时逻辑（主要是因为TIdSync内部使用的TThread.Synchronize()没有超时逻辑）。

您不能在TIdSync对象运行时销毁它。 同步过程已排队等待执行或开始运行后， 无法过早中止。 必须允许它运行完成。

TIdSync.DoSynchronize() （或与TThread.Queue()或TThread.Synchronize()同步的任何方法TThread.Queue()在主UI线程的上下文中执行。 长时间运行的代码应在其自己的线程中执行，而不应在主UI线程中执行。 确保未阻止主UI线程及时处理新消息和同步请求。

如果要停止同步的过程，则需要让它处理TEvent对象或其他标志，以便工作线程在需要时可以发出信号，并且该过程会定期检查，以便可以尽快退出（正常运行或通过引发例外）。

任何性质的同步操作都应简短，以防止阻塞/死锁，资源匮乏等。您需要重新考虑设计。 您做事的方式是错误的。