线程在午夜完全停止，我做错了什么？

Question

我在我的程序中实现了 3 个辅助线程。

GET第一个通过每 2 分钟向每个外部设备发送一个 HTTP 请求来检查外部设备的在线状态。

第二个用于“实时查看”功耗，每 2 秒检查一次外部设备的值，并在主线程中使用一些进度条/标签显示它们。

第三个等待并每隔一小时从同一设备获取其他值并将它们写入文件。

在线程 #3 中没有Synchronize()必要（我认为），因为主线程获取文件并根据用户命令从中构建图表。

实际上，所有线程都像魅力一样运行几个小时，直到午夜。第一个线程 24/7 持续运行，没有任何问题，但其他两个线程似乎在午夜锁定。

主窗口始终保持功能状态。

如果我关闭程序并重新启动它，一切都会再次正常工作，但在 00:00h ... finito 丢失了线程。

难道是程序中的等待循环有问题Execute()？到目前为止我还没有找到。

我是第一次来，如有遗漏或不清楚的地方，请多多包涵！

这是线程 #1 的声明和实现：

type
  TpingThread = class(TThread)
  private
    pingHTTP: TidHTTP;
  public
    constructor Create;
    procedure updateOnlineStatus;
  protected
    procedure Execute; override;
  end;

constructor TPingThread.Create;
begin
  Self.Suspended := False;
  Self.FreeOnTerminate := False;
  inherited Create(False);
end;

//"pings" all networkdevices, runs until program ends
procedure TPingThread.Execute;
Var delayTime: TDateTime;
    n: Byte;
    s: String;
begin
pingHTTP := TIdHTTP.Create(NIL); pingHTTP.ConnectTimeout := 3000; pingHTTP.ReadTimeout := 3000;
while NOT Terminated do begin
      for n := 0 to High(PingRec) do begin //8 devices
          blockRequests := True;
          try
            if (n = 0) then s := pingHTTP.Get('http://' + PingRec[n].Pingtarget)
                       Else s := pingHTTP.Get('http://' + PingRec[n].Pingtarget + '/status');
            if (s = '') Then PingRec[n].PingResult := False
                        Else PingRec[n].PingResult := True;
          except 
            PingRec[n].PingResult := False; 
          end;
                                   end; //For n
      Synchronize(updateonlineStatus);
      blockRequests := False;
      delayTime := system.DateUtils.IncSecond(Time,PingDelay);
      while (Time < DelayTime) do begin 
            Sleep(100);
            Application.ProcessMessages; 
            if (Terminated) then Break;
                                  end;
                        end;
pingHTTP.Free;
end;

procedure TpingThread.updateOnlineStatus;
Var aDev: TNetDevice; //component for a physical device
    n: Byte;
begin
for n := 0 to High(PingRec) do begin
    aDev := fMain.FC(PingRec[n].PingDevice) AS TNetDevice;
    if (PingRec[n].PingResult = False) then aDev.Status := stDOffline 
                       Else begin 
       case adev.Status of 
            stDStandby,stDOffline: aDev.Status := stDOnline; 
       end; //case
                                            end;
                             end; //for n
end;

线程 #2 和 #3 相同：

type
  TliveViewThread = class(TThread)
  private
    liveHTTP: TidHTTP;
  public
    PVPower,HTotal,L1,L2,L3: Extended;
    constructor Create;
    function currentPVPower(aIP: String): Double;
    function currentConsumption(aIP: String; Var L1,L2,L3: Extended): Extended;
    function getpowerFromStr(aStr: String): Extended;
    procedure updatePBars;
  protected
    procedure Execute; override;
  end;

type
  ThourThread = class(TThread)
  private
    hourHTTP: TidHTTP;
  public
    L1,L2,L3: Extended;
    constructor Create;
    function isTimeInRange: Boolean; //true if full hour
    function makeList(IP1,IP2,IP3: String): TStringList;
    procedure getValues(aString: String; Var PActive,PReturned: String);
    function getEntryandMakeList(fromList: TStringList; KeyName,delimiter: String): TStringList;
    procedure valuestoFile(V1,V2,V3: Extended);
  protected
    procedure Execute; override;
  end;

constructor TliveViewThread.Create;
begin
  Self.Suspended := False;
  Self.FreeOnTerminate := False;
  inherited Create(False);
end;

//updates some progressbars with values obtained from powermeasurement devices
procedure TliveViewThread.Execute;
Var delayTime: TDateTime; //WaitTimersimulation
begin
liveHTTP := TIdHTTP.Create(NIL);
while Not Terminated do begin
      //viewmode set when user activates a certain tab in main window
      if (ViewMode = vmLive) AND (blockEMs = False) then begin //LiveView
         //.Status checked and set by pingthread
         if (fMain.DEV6.Status = stDOnline) AND (fmain.DEV7.Status = stDOnline) then begin
            PVPower := currentPVPower(fMain.DEV6.DeviceIP);
            HTotal := currentConsumption(fMain.DEV7.DeviceIP,L1,L2,L3);
            Synchronize(updatePBars);
                                                                                     end; 
                                                          end; //LiveView
      delayTime := system.DateUtils.IncSecond(Time,3);
      while (Time < DelayTime) do begin 
            Sleep(100);
            Application.ProcessMessages;
            If (Terminated) then Break; 
                                  end; //While delay
                        end; //While NOT Terminated
liveHTTP.Free;
end;

//fills values into a file that can be used by main thread at any time
constructor ThourThread.Create;
begin
  Self.Suspended := False;
  Self.FreeOnTerminate := False;
  inherited Create(False);
end;

procedure ThourThread.Execute;
Var delayTime: TDateTime; //WaitTimersimulation
begin
hourHTTP := TIdHTTP.Create(NIL);
while Not Terminated do begin
      if (fMain.DEV6.Status = stDOnline) AND (fmain.DEV7.Status = stDOnline) then begin
         if (isTimeInRange) then makeList(fMain.DEV7.DeviceIP,fMain.DEV6.DeviceIP,'');
                                                                                  end;
      delayTime := system.DateUtils.IncSecond(Time,2);
      while (Time < DelayTime) do begin 
            Sleep(10); 
            Application.ProcessMessages; 
            If (Terminated) then Break; 
                                  end; //while delay
                        end; //While NOT Terminated
hourHTTP.Free;
end;

线程在表单显示后启动：

procedure TfMain.WmAfterShow(var Msg: TMessage);
begin
...
if (AfterCreate) Then begin
   ....
   PingThread := TpingThread.Create;
   //blockRequests is used to make the program wait until all online-states are checked
   While (blockRequests) do begin 
         Application.ProcessMessages; 
         Sleep(50); 
                            end;
   ...   
   liveViewThread := TliveViewThread.Create;
   hourThread := ThourThread.Create; 
   ...
   afterCreate := False;
                      end; //AfterCreate
end;

这是线程被/应该被销毁的唯一点：

procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
....
if Assigned(PingThread) then PingThread.Terminate;
if Assigned(liveViewThread) then liveViewThread.Terminate;
if Assigned(hourThread) then hourThread.Terminate;
PingThread.Free;
liveViewThread.Free;
hourThread.Free;
....
canClose := True;
end;

线程 #2 和 #3 一开始是一个线程，然后我将它们分成两个单独的线程，没有任何变化。

我延长了delayTime，没有变化。

我改变了Sleep()价值观，没有改变。

我评论了If condition "DEvx.Status..."，没有改变。

我try..except到处实现了 s，希望避免一些“无声崩溃”，抱歉我不是编程专家。

我在线程循环的不同位置实现了一个填充日期和确切时间的变量，以找出它可能停止的位置。

至少它告诉我这不是子程序的问题。最后一个条目总是在之前While Time < DelayTime

Answer 1

ATDateTime被实现为浮点Double值，其中整数部分是自 以来经过的天数December 30 1899，小数部分表示自午夜以来经过的天数00:00:00。

该SysUtils.Time()函数仅返回当前时间，因此日期设置为0（同样，该SysUtils.Date()函数仅返回当前日期，因此时间设置为0）。

假设Time()恰好返回一个非常接近第二天的时间值，例如23:59:59（即1899-12-30 23:59:59）。然后将该日期/时间保存到delayTime变量中。如果您添加足够的秒数以使其实际上跨越到第二天，假设 3 秒00:00:02（即1899-12-31 00:00:02），那么您的循环开始比较Time() < delayTime，这将始终评估为 true ，因为Time() 总是返回 date 上的时间1899-12-30，因此返回值将始终小于1899-12-31您存储在 中的日期delayTime。这意味着，每当您增量delayTime到第二天时，您的循环就会陷入无休止的运行，直到线程终止。

另一方面，假设delayTime第二天不会增加，例如，如果Time()返回23:59:55（即1899-12-30 23:59:55）并将 3 秒添加到该值，使其成为23:59:58（即1899-12-30 23:59:58）。这样您的循环就只剩下1 秒的机会窗口，在该窗口中您的循环可能会看到后续调用Time()return 23:59:59（即1899-12-30 23:59:59）来中断循环。但是，一旦Time()回滚到00:00:00(ie 1899-12-30 00:00:00)，循环就会卡住，等待当前时间24 小时以赶上下一个1 秒窗口，或者直到线程终止。

为了避免这两个问题，您的循环必须考虑当前日期和时间，因此请使用该SysUtils.Now()函数，例如：

delayTime := System.DateUtils.IncSecond(Now, PingDelay);
while (Now < delayTime) do begin
  Sleep(100);
  if (Terminated) then Break;
end;

注意：这些Time()//Date()函数Now()以本地时钟时间表示，因此它们会受到可能发生的任何时钟更改的影响（即夏令时、网络时间同步、用户操作等），这将导致延迟循环。

您应该使用完全不依赖于时钟的延迟机制。例如，通过使用WaitForMultipleObjects()等待可等待计时器和当您想要终止线程时发出信号的事件对象（即），例如：SyncObjs.TEvent

type
  TPingThread = class(TThread)
  private
    termEvent: TEvent;
    hDelayTimer: THandle;
    function Delay(Seconds: Integer); Boolean;
    ...
  protected
    procedure TerminatedSet; override;
  ...
  end;

...

procedure TPingThread.Create;
begin
  inherited Create(False);
  termEvent := TEvent.Create;
  hDelayTimer := CreateWaitableTimer(nil, TRUE, nil);
  if hDelayTimer = 0 then
    RaiseLastOSError;
  ...
end;

procedure TPingThread.Destroy;
begin
  ...
  termEvent.Free;
  if hTimer <> 0 then CloseHandle(hTimer);
  inherited Destroy;
end;

procedure TPingThread.TerminatedSet;
begin
  inherited;
  termEvent.SetEvent;
end;

function TPingThread.Delay(Seconds: Integer); Boolean;
var
  dueTime: LARGE_INTEGER;
  arr[0..1] of THandle;
  which: DWORD;
begin
  dueTime.QuadPart = -(Int64(Seconds)*10000000);
  if not SetWaitableTimer(hDelayTimer, dueDate, 0, nil, nil, False) then
    RaiseLastOSError;
  try
    arr[0] := hDelayTimer;
    arr[1] := termEvent.Handle;
    which := (WaitForMultipleObjects(2, arr, FALSE, INFINITE);
    if which = WAIT_FAILED then RaiseLastOSError;
  finally
    CancelWaitableTimer(hTimer);
  end;
  Result := (which = WAIT_OBJECT_0);
end;

...

procedure TPingThread.Execute;
var
  ...
begin
  ...
  while not Terminated do
  begin
    ...
    if not Delay(PingDelay) then
      Break;
    ...
  end;
  ...
end;

尽可能避免繁忙循环。这种方法的好处不仅是您不再依赖时钟，而且还允许线程真正进入睡眠状态，直到计时器到期或发出终止事件信号。这样，您就不会浪费 CPU 周期，从而允许其他线程同时完成其工作。WaitForMultipleObjects()将告诉您哪个对象满足等待，以便您可以采取相应的行动（即执行下一个线程循环迭代，或退出线程）。

就此而言，这在主线程中也很有用（尽管您根本不应该阻塞主线程）。例如，您的While (blockRequests)循环可以替换为 a TEvent，然后您可以在想要阻止时向该事件发出信号，并用于MsgWaitForMultipleObjects()等待该事件重置，同时知道何时为主消息队列提供服务，因为它会告诉您何时消息实际上正在队列中等待，因此您不必ProcessMessages()不必要地调用。

尽管如此，您确实应该考虑重新设计该blockRequests逻辑以异步运行。