Synchronise strange behavior in service - multithreading

Question

I have a service where in the main thread I store some data and read it sometimes from the child thread.
With Delphi 7 everything worked fine.
Service execute, child thread create, main thread made the data, child thread called Synchronise to get it ... and waited until main thread ServiceThread.ProcessRequests(True);
Now with Delphi 10.3 it seems that Synchronise is not waiting for the main thread to get to the ProcessRequests (idle) ... it calls in the middle of the main Execute processing.
main service thread:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;
type
TTestserv2 = class(TService)
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
procedure log(msg: String);
public
function GetServiceController: TServiceController; override;
function getArrayItem(i: integer): string;
{ Public declarations }
protected
function DoCustomControl(CtrlCode: Cardinal): Boolean; override;
end;
Const
SERVICE_CONTROL_MyMSG = 10;
var
Testserv2: TTestserv2;
implementation
{$R *.dfm}
Uses unit2;
Var
array1 : Array of string;
Thread1 : T_Thread1;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Testserv2.Controller(CtrlCode);
end;
function TTestserv2.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TTestserv2.log(msg: String);
Var
F:TextFile;
LogFile:String;
TmpStr:String;
begin
try
LogFile := 'c:\testlog1.txt';
AssignFile(F, LogFile);
If FileExists(LogFile) then
Append(F)
Else
Rewrite(F);
DateTimeToString(TmpStr,'yyyy.mm.dd. hh:nn:ss',now);
WriteLN(F,TmpStr+' - '+Msg);
Flush(F);
Finally
CloseFile(F);
End;
end;
function TTestserv2.DoCustomControl(CtrlCode: Cardinal): Boolean;
begin
result := true;
case CtrlCode of
SERVICE_CONTROL_MyMSG : log('MyMSG');
end;
end;
procedure TTestserv2.ServiceExecute(Sender: TService);
var
Msg: String;
i: integer;
s: string;
Begin
Log('Service Execute');
SetLength(array1, 20);
Thread1 := T_Thread1.Create;
Thread1.Priority:=tpNormal;
Thread1.Resume;
Log('Thread1 created');
// Where the magic happens
for i := 0 to 21 do
Begin
s := 'value='+ IntToStr( i*2);
array1[i] := s;
Log( IntToStr(i) + '-' + s);
sleep(100); // in real code some idSNMP query here
End;
while not Terminated do
begin
Sleep(50);
Log('Service Execute OK ');
If Terminated then
Log('Terminated');
ServiceThread.ProcessRequests(True);
end;
End;
function TTestserv2.getArrayItem(i:integer):string;
Begin
result := array1[i];
End;
end.
Child thread:
unit unit2;
interface
uses
Windows, Classes, SysUtils, ExtCtrls, SyncObjs, ADODB, ActiveX, Unit1;
type
T_Thread1 = class(TThread)
private
{ Private declarations }
FWakeupEvent : TSimpleEvent;
procedure Log(Msg:String);
procedure Terminate1(Sender: TObject);
Procedure getdataproc;
protected
procedure Execute; override;
public
constructor Create;
Destructor Destroy; override;
end;
implementation
{ T_Thread1 }
constructor T_Thread1.Create;
begin
inherited Create(True);
OnTerminate := Terminate1;
FreeOnTerminate := False;
End;
procedure T_Thread1.Terminate1(Sender: TObject);
Var
s2:String;
begin
CoUninitialize;
End;
Destructor T_Thread1.Destroy;
Begin
If not Terminated Then Terminate;
inherited;
End;
procedure T_Thread1.log(msg: String);
Var
F:TextFile;
LogFile:String;
TmpStr:String;
begin
try
LogFile := 'c:\testlog2.txt';
AssignFile(F, LogFile);
If FileExists(LogFile) then
Append(F)
Else
Rewrite(F);
DateTimeToString(TmpStr,'hh:nn:ss',now);
WriteLN(F,TmpStr+' - '+Msg);
Flush(F);
Finally
CloseFile(F);
End;
end;
procedure T_Thread1.Execute;
Var
WaitStatus: Cardinal;
begin
LOG('Execute Start');
CoInitialize(nil);
FWakeupEvent := TSimpleEvent.Create;
repeat
WaitStatus := WaitForSingleObject(FWakeupEvent.Handle, 1000);
case WaitStatus of
WAIT_OBJECT_0: Break;
WAIT_TIMEOUT:
Begin
Log('Timeout');
Synchronize(getdataproc);
End;
Else Break;
end;
until (Terminated);
FreeAndNil(FWakeupEvent);
end;
Procedure T_Thread1.getdataproc;
Var
i:integer;
res:string;
Begin
for i := 0 to 21 do
Begin
res := Testserv2.getArrayItem(i);
log(IntToStr(i)+ '-' + res);
End;
End;
end.
and the result
log1 for main:
16:27:01 - Service Execute
16:27:01 - Thread1 created
16:27:01 - 0-value=0
16:27:01 - 1-value=2
16:27:01 - 2-value=4
16:27:01 - 3-value=6
16:27:01 - 4-value=8
16:27:01 - 5-value=10
16:27:01 - 6-value=12
16:27:02 - 7-value=14
16:27:02 - 8-value=16
16:27:02 - 9-value=18
16:27:02 - 10-value=20
16:27:02 - 11-value=22
16:27:02 - 12-value=24
16:27:02 - 13-value=26
16:27:02 - 14-value=28
16:27:02 - 15-value=30
16:27:03 - 16-value=32
16:27:03 - 17-value=34
16:27:03 - 18-value=36
16:27:03 - 19-value=38
16:27:03 - 20-value=40
16:27:03 - 21-value=42
16:27:03 - Service Execute OK
log2 for child thread:
16:27:01 - Execute Start
16:27:02 - Timeout
16:27:02 - 0-value=0
16:27:02 - 1-value=2
16:27:02 - 2-value=4
16:27:02 - 3-value=6
16:27:02 - 4-value=8
16:27:02 - 5-value=10
16:27:02 - 6-value=12
16:27:02 - 7-value=14
16:27:02 - 8-value=16
16:27:02 - 9-value=18
16:27:02 - 10-
16:27:02 - 11-
16:27:02 - 12-
16:27:02 - 13-
16:27:02 - 14-
16:27:02 - 15-
16:27:02 - 16-
16:27:02 - 17-
16:27:02 - 18-
16:27:02 - 19-
16:27:02 - 20-
16:27:02 - 21-
16:27:03 - Timeout
16:27:03 - 0-value=0
16:27:03 - 1-value=2
16:27:03 - 2-value=4
16:27:03 - 3-value=6
16:27:03 - 4-value=8
16:27:03 - 5-value=10
16:27:03 - 6-value=12
16:27:03 - 7-value=14
16:27:03 - 8-value=16
16:27:03 - 9-value=18
16:27:03 - 10-value=20
16:27:03 - 11-value=22
16:27:03 - 12-value=24
16:27:03 - 13-value=26
16:27:03 - 14-value=28
16:27:03 - 15-value=30
16:27:03 - 16-value=32
16:27:03 - 17-value=34
16:27:03 - 18-value=36
16:27:03 - 19-
16:27:03 - 20-
16:27:03 - 21-
16:27:04 - Timeout
16:27:04 - 0-value=0
16:27:04 - 1-value=2
16:27:04 - 2-value=4
16:27:04 - 3-value=6
16:27:04 - 4-value=8
16:27:04 - 5-value=10
16:27:04 - 6-value=12
16:27:04 - 7-value=14
16:27:04 - 8-value=16
16:27:04 - 9-value=18
16:27:04 - 10-value=20
16:27:04 - 11-value=22
16:27:04 - 12-value=24
16:27:04 - 13-value=26
16:27:04 - 14-value=28
16:27:04 - 15-value=30
16:27:04 - 16-value=32
16:27:04 - 17-value=34
16:27:04 - 18-value=36
16:27:04 - 19-value=38
16:27:04 - 20-value=40
16:27:04 - 21-value=42
So for the first two round the child calls in the middle of the for cycle of the main.
Does not wait. In real code array is an array of records with more string and integer items.
Sometimes (very very rare) result is like this: ???†??????e se OK ?ô
Like Synchronise is not working properly. (compiled to 32 and 64 bit, same result)
What can I do? Not thrust Synchronise ? Criticalsection ?
Do not want to rewrite everything.
The child PostThreadMessage CM_SERVICE_CONTROL_CODE to main, and main PostThreadMessage back with a bit more data (some kB) ... I try to avoid.
Any suggestions ?

Answer 1

The TService.OnExecute event is NOT fired in the actual main thread! It is fired in a worker thread that is created by the main thread. The main message loop that handles TThread.Synchronize() requests is in the project's .dpr file where TServiceApplication.Run() is called.
In a typical TService project, there are at least 3 threads running by default:
the project main thread, which handles the main message loop, and fires each TService's (Before|After)Install and (Before|After)Uninstall events if needed.
the StartServiceCtrlDispatcher() thread, which maintains a connection to the SCM, and dispatches SCM requests to each TService.Controller callback.
a thread for each TService, which fires that service's On(Start|Stop|Shutdown), On(Pause|Continue), and OnExecute events based on SCM requests received by the StartServiceCtrlDispatcher() thread.
When your OnExecute event handler calls ServiceThread.ProcessRequests(), it is handling pending SCM requests - in the form of CM_SERVICE_CONTROL_CODE messages that are posted to the TService's thread from the TService.Controller callback function, which is called by StartServiceCtrlDispatcher() in a worker thread that is created by the main thread. It is NOT handling pending Synchronize() requests at all.
So, your 2 threads are NOT synchronizing with each other at all. You need to re-think your synchronization logic. If you want your T_Thread1 to sync with your TTestserv2, then one option would be to have TTestserv2 create a hidden HWND for itself (such as with System.Classes.AllocateHWnd()) and then T_Thread1 can send/post window messages to that HWND as needed. Calling ProcessRequests() in the OnExecute event (in TTestserv2's thread) will dispatch those window messages as needed.
Also, speaking of ProcessRequests(), know that calling ProcessRequests() with WaitForMessage=True will block the calling thread until the service is terminated, processing all SCM requests (and window messages) internally as needed. If you want your OnExecute event handler to run its own loop, you need to call ProcessRequests() with WaitForMessage=False instead.
And FYI, everything I have said applies to Delphi 7, too.