同步服务中的奇怪行为

Question

我有一个服务，我在主线程中存储一些数据并有时从子线程中读取它。 使用 Delphi 7 一切正常。 服务执行、子线程创建、主线程生成数据、子线程调用Synchronise获取数据……等到主线程ServiceThread.ProcessRequests(True);

现在使用 Delphi 10.3，Synchronise 似乎没有等待主线程到达 ProcessRequests（空闲）...它在主执行处理过程中调用。

主服务线程：

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.

子线程：

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.

结果

主日志：

    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：

    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

所以对于前两轮，孩子在主循环的中间调用。

不等待。在实际代码中，数组是一个包含更多字符串和整数项的记录数组。

有时（非常非常罕见）结果是这样的：???†??????e se OK ?ô 像同步无法正常工作。 （编译成 32 位和 64 位，结果相同）

我能做什么？不推力同步？临界区？

不想重写一切。 子 PostThreadMessage CM_SERVICE_CONTROL_CODE 到 main，而 main PostThreadMessage 返回了更多数据（一些 kB）......我尽量避免。

有什么建议吗？

Answer 1

TService.OnExecute 事件不会在实际的主线程中触发！它在由主线程创建的工作线程中触发。处理TThread.Synchronize() 请求的主消息循环位于项目的.dpr 文件中，其中调用了TServiceApplication.Run()。

在一个典型的TService项目中，默认至少有3个线程在运行：

• 项目主线程，它处理主消息循环，并在需要时触发每个TService 的(Before|After)Install 和(Before|After)Uninstall 事件。

• StartServiceCtrlDispatcher() 线程，它维护与 SCM 的连接，并将 SCM 请求分派给每个 TService.Controller 回调。

• 每个TService 都有一个线程，它根据StartServiceCtrlDispatcher() 线程收到的SCM 请求触发该服务的On(Start|Stop|Shutdown)、On(Pause|Continue) 和OnExecute 事件。

当您的OnExecute 事件处理程序调用ServiceThread.ProcessRequests() 时，它正在处理挂起的SCM 请求- 以CM_SERVICE_CONTROL_CODE 消息的形式从TService.Controller 回调函数发布到TService 的线程，这由StartServiceCtrlDispatcher() 在主线程创建的工作线程中调用。它根本不处理待处理的Synchronize() 请求。

所以，您的 2 个线程根本没有相互同步。您需要重新考虑您的同步逻辑。如果您希望您的T_Thread1 与您的TTestserv2 同步，那么一种选择是让TTestserv2 为自己创建一个隐藏的HWND（例如使用System.Classes.AllocateHWnd()），然后T_Thread1 可以发送/发布根据需要向HWND 发送窗口消息。在OnExecute 事件（在TTestserv2 的线程中）调用ProcessRequests() 将根据需要调度这些窗口消息。

另外，说到ProcessRequests()，知道用WaitForMessage=True 调用ProcessRequests() 将阻塞调用线程，直到服务终止，在内部处理所有 SCM 请求（和窗口消息）作为需要。如果您希望 OnExecute 事件处理程序运行自己的循环，则需要使用 WaitForMessage=False 来调用 ProcessRequests()。

仅供参考，我所说的一切也适用于 Delphi 7。