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

q35jwt9p 于 2023-05-06 发布在其他

关注(0)|答案(3)|浏览(188)

我在我的程序中实现了3个辅助线程。
第一个检查外部设备的在线状态，每2分钟向每个设备发送一个HTTP GET请求。
第二个用于“实时查看”功耗，每2秒检查外部设备的值，并在主线程中使用一些进度条/标签显示它们。
第三个等待，并从相同的设备获得其他值，每一个完整的小时，并将它们写入一个文件。
在线程#3中不需要Synchronize()（我认为），因为主线程获取文件并根据用户命令构建图表。
事实上，所有的线程都像一个魅力一样运行了几个小时，直到午夜。第一个线程保持24/7无问题地运行，但其他两个线程似乎在午夜锁定。
主窗口始终保持功能。
如果我关闭程序并重新启动它，一切都再次正常工作，但在00：00 h...threads结束。
难道是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，希望避免一些“无声的崩溃”，对不起，我不是编程Maven。
我在线程循环的不同位置实现了一个用日期和确切时间填充的变量，以找出它可能停止的位置。
至少它向我表明，这不是一个问题，在子程序。最后一项始终在While Time < DelayTime之前

delphi

来源：https://stackoverflow.com/questions/76141414/threads-stopping-exactly-at-midnight-what-do-i-do-wrong

3条答案

按热度按时间

u5i3ibmn1#

TDateTime实现为浮点值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() * 总是 * 返回日期1899-12-30的时间，因此返回的值将 * 总是 * 小于您存储在delayTime中的1899-12-31日期。这意味着，无论何时将delayTime递增到第二天，循环都将陷入运行无休止的状态，直到线程终止。
另一方面，假设delayTime不会在第二天增加，例如，如果Time()返回23:59:55（即1899-12-30 23:59:55），并且将该值添加3秒，使其成为23:59:58（即1899-12-30 23:59:58）。这只给你留下了一个1秒的机会窗口，在这个窗口中，你的循环 * 可能 * 看到一个对Time()的后续调用返回23:59:59（即1899-12-30 23:59:59）来中断循环。但是，一旦Time()回滚到00:00:00（即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()来等待waitable timer和event object（即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)循环可以替换为TEvent，然后你可以在你想要阻止的时候发出信号，并使用MsgWaitForMultipleObjects()等待事件被重置，同时知道什么时候服务主消息队列，因为它会告诉你什么时候消息真的在队列中等待，所以你不必不必要地调用ProcessMessages()。
不过，您确实应该考虑重新设计blockRequests逻辑，使其异步运行。