Search code examples
multithreadingdelphiservicedelphi-10.3-rio

Synchronise strange behavior in service

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 ?

Solution

  • 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.