I have implemented 3 secondary threads in my program.
First one checks the online state of external devices by sending an HTTP GET request to each of them every 2 minutes.
Second one is intended for a "live-view" of power-consumption, checking values of external devices every 2 seconds and displaying them using some progressbars/labels in the main thread.
Third one waits and obtains other values from the same devices every full hour and writes them to a file.
No Synchronize() is necessary in thread #3 (I think) since the main thread takes the file and builds a chart from it on user command.
Actually, all threads run like a charm for hours and hours, until midnight. The first thread keeps running without a problem 24/7, but the other two seem to lock up at midnight.
The main window stays functional all the time.
If I close the program and restart it, everything works fine again, but at 00:00h ... finito los threads.
Could it be that there's a problem with the waiting loop in the Execute() procedure? I couldn't find one so far.
Please forgive me if some information is missing, or if I'm not clear enough, it's my first time here!
Here's declaration and implementation of thread #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;
Same for thread #2 and #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;
The threads are started after the Form is shown:
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;
This is the only point where the threads are/should be destroyed:
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;
Thread #2 and #3 were one thread in the beginning, then I split them into two separate ones, no change.
I extended the delayTime, no change.
I changed the Sleep() values, no change.
I commented the If condition "DEvx.Status...", no change.
I implemented try..excepts everywhere, hoping to avoid some "silent crash", sorry I'm not a programming expert.
I implemented a variable filled with date and exact time in different locations of the thread loop to find out where it might have stopped.
At least it showed me that it was not a problem in the subroutines.
The last entry was always before While Time < DelayTime
A TDateTime is implemented as a floating-point Double value, where the integral portion is the number of days that have elapsed since December 30 1899, and the fractional portion represents the time of the day since midnight 00:00:00.
The SysUtils.Time() function returns only the current time, so the date is set to 0 (similarly, the SysUtils.Date() function returns only the current date, so the time is set to 0).
Let's say Time() happens to return a time value that is very close to the next day, say 23:59:59 (ie 1899-12-30 23:59:59). You then save that date/time to your delayTime variable. If you then add enough seconds to make it actually cross into the next day, let's say 3 seconds to 00:00:02 (ie 1899-12-31 00:00:02), then your loop starts comparing Time() < delayTime, that will always evaluate as true since Time() always returns a time on the date 1899-12-30, so the returned value will always be less than the 1899-12-31 date that you have stored in delayTime. This means, whenever you increment delayTime into the next day, your loop will get stuck running endlessly until the thread is terminated.
On the flip side, let's say delayTime does not get incremented into the next day, for example if Time() returns 23:59:55 (ie 1899-12-30 23:59:55) and 3 seconds are added to that value, making it 23:59:58 (ie 1899-12-30 23:59:58). That leaves you with only a 1-second window of opportunity in which your loop might see a subsequent call to Time() return 23:59:59 (ie 1899-12-30 23:59:59) to break the loop. But, once Time() rolls back to 00:00:00 (ie 1899-12-30 00:00:00), your loop then gets stuck waiting 24 hours for the current time to catch up to the next 1-second window, or until the thread is terminated.
To avoid both of these issues, your loop must account for the current date AND time, so use the SysUtils.Now() function instead, eg:
delayTime := System.DateUtils.IncSecond(Now, PingDelay);
while (Now < delayTime) do begin
Sleep(100);
if (Terminated) then Break;
end;
Note: these Time()/Date()/Now() functions are expressed in local clock time, so they are affected by any clock changes that may occur (ie, daylight savings, network time syncs, user manipulation, etc), which will throw off your delay loop.
You should instead use a delay mechanism that is not dependent on the clock at all. For example, by using WaitForMultipleObjects() to wait on a waitable timer and an event object (ie SyncObjs.TEvent) that is signaled when you want to terminate the thread, eg:
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;
Always try to avoid busy looping whenever you can. The benefit of this approach is not only do you not rely on the clock anymore, but you also allow the thread to truely go to sleep until either the timer elapses or the terminate event is signaled. This way, you are not wasting CPU cycles in between, allowing other threads to do their work in the meantime. WaitForMultipleObjects() will tell you which object satisfied the wait so you can act accordingly (ie, do the next thread loop iteration, or exit the thread).
This is also useful in the main thread too, for that matter (although, you should not block the main thread at all). For instance, your While (blockRequests) loop could be replaced with a TEvent, and then you can signal the event when you want to block and use MsgWaitForMultipleObjects() to wait on that event to be reset while knowing when to service the main message queue, as it will tell you when a message is actually waiting in the queue so you don't have to call ProcessMessages() unnecessarily.
Although, you really should consider redesigning that blockRequests logic to run asynchronously instead.