同步服务中的奇怪行为
Synchronise strange behavior in service
我有一个服务，我在主线程中存储一些数据，有时从子线程中读取它。
使用 Delphi 7 一切正常。
服务执行，子线程创建，主线程生成数据，子线程调用 Synchronise 获取数据...并等待主线程 ServiceThread.ProcessRequests(True);
现在 Delphi 10.3 似乎 Synchronise 没有等待主线程到达 ProcessRequests（空闲）......它在中间调用main 执行处理。
主要服务线程：
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.
结果
主日志 1：
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
因此，对于前两轮，子进程在主进程的 for 循环中间调用。
不等待。在实际代码中，数组是一个包含更多字符串和整数项的记录数组。
有时（非常非常罕见）结果是这样的：???† ??????e se OK ?ô
就像 Synchronize 无法正常工作一样。 （编译为 32 位和 64 位，结果相同）
我能做什么？不是推力同步？临界区 ?
不想重写一切。
子 PostThreadMessage CM_SERVICE_CONTROL_CODE 到 main，主 PostThreadMessage 返回更多数据（一些 kB）...我尽量避免。
有什么建议吗？
调用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()。
在典型的TService项目中，默认至少有3个线程运行ning:
项目主线程，处理主消息循环，并在需要时触发每个 TService 的 (Before|After)Install 和 (Before|After)Uninstall 事件。
StartServiceCtrlDispatcher() 线程，它保持与 SCM 的连接，并将 SCM 请求分派给每个 TService.Controller 回调。
每个 TService 的一个线程，它根据接收到的 SCM 请求触发该服务的 On(Start|Stop|Shutdown)、On(Pause|Continue) 和 OnExecute 事件StartServiceCtrlDispatcher() 线程。
当您的 OnExecute 事件处理程序调用 ServiceThread.ProcessRequests() 时，它正在处理未决的 SCM 请求 - 以 CM_SERVICE_CONTROL_CODE 消息的形式发布到 TService 的来自 TService.Controller 回调函数的线程，由 StartServiceCtrlDispatcher() 在主线程创建的工作线程中调用。它根本不处理待处理的 Synchronize() 请求 。
因此，您的 2 个线程根本 彼此不同步。您需要 re-think 您的同步逻辑。如果您希望 T_Thread1 与 TTestserv2 同步，那么一种选择是让 TTestserv2 为自己创建一个隐藏的 HWND（例如 System.Classes.AllocateHWnd() ) 然后 T_Thread1 可以根据需要 send/post window 向 HWND 发送消息。在 OnExecute 事件中调用 ProcessRequests()（在 TTestserv2 的线程中）将根据需要分派那些 window 消息。
另外，说到ProcessRequests()，知道用WaitForMessage=True调用ProcessRequests()会阻塞调用线程，直到服务终止，处理all SCM 根据需要在内部请求（和 window 消息）。如果您希望 OnExecute 事件处理程序 运行 它自己的循环，您需要使用 WaitForMessage=False 调用 ProcessRequests()。
仅供参考，我所说的一切也适用于 Delphi 7。
我有一个服务，我在主线程中存储一些数据，有时从子线程中读取它。
使用 Delphi 7 一切正常。
服务执行，子线程创建，主线程生成数据，子线程调用 Synchronise 获取数据...并等待主线程 ServiceThread.ProcessRequests(True);
现在 Delphi 10.3 似乎 Synchronise 没有等待主线程到达 ProcessRequests（空闲）......它在中间调用main 执行处理。
主要服务线程：
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.
结果
主日志 1：
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
因此，对于前两轮，子进程在主进程的 for 循环中间调用。
不等待。在实际代码中，数组是一个包含更多字符串和整数项的记录数组。
有时（非常非常罕见）结果是这样的：???† ??????e se OK ?ô 就像 Synchronize 无法正常工作一样。 （编译为 32 位和 64 位，结果相同）
我能做什么？不是推力同步？临界区 ?
不想重写一切。 子 PostThreadMessage CM_SERVICE_CONTROL_CODE 到 main，主 PostThreadMessage 返回更多数据（一些 kB）...我尽量避免。
有什么建议吗？
调用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()。
在典型的TService项目中，默认至少有3个线程运行ning:
项目主线程，处理主消息循环，并在需要时触发每个
TService的(Before|After)Install和(Before|After)Uninstall事件。StartServiceCtrlDispatcher()线程，它保持与 SCM 的连接，并将 SCM 请求分派给每个TService.Controller回调。每个
TService的一个线程，它根据接收到的 SCM 请求触发该服务的On(Start|Stop|Shutdown)、On(Pause|Continue)和OnExecute事件StartServiceCtrlDispatcher()线程。
当您的 OnExecute 事件处理程序调用 ServiceThread.ProcessRequests() 时，它正在处理未决的 SCM 请求 - 以 CM_SERVICE_CONTROL_CODE 消息的形式发布到 TService 的来自 TService.Controller 回调函数的线程，由 StartServiceCtrlDispatcher() 在主线程创建的工作线程中调用。它根本不处理待处理的 Synchronize() 请求 。
因此，您的 2 个线程根本 彼此不同步。您需要 re-think 您的同步逻辑。如果您希望 T_Thread1 与 TTestserv2 同步，那么一种选择是让 TTestserv2 为自己创建一个隐藏的 HWND（例如 System.Classes.AllocateHWnd() ) 然后 T_Thread1 可以根据需要 send/post window 向 HWND 发送消息。在 OnExecute 事件中调用 ProcessRequests()（在 TTestserv2 的线程中）将根据需要分派那些 window 消息。
另外，说到ProcessRequests()，知道用WaitForMessage=True调用ProcessRequests()会阻塞调用线程，直到服务终止，处理all SCM 根据需要在内部请求（和 window 消息）。如果您希望 OnExecute 事件处理程序 运行 它自己的循环，您需要使用 WaitForMessage=False 调用 ProcessRequests()。
仅供参考，我所说的一切也适用于 Delphi 7。