# revisions: 46326,46327

git-svn-id: branches/fixes_3_2@47091 -

packages/fcl-extra/src/daemonapp.pp

@@ -55,7 +55,8 @@ Type
     Function ShutDown : Boolean; virtual;
     Function Install : Boolean; virtual;
     Function UnInstall: boolean; virtual;
-    Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
+    Function HandleCustomCode(ACode : DWord) : Boolean; virtual;
+    Function HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer) : Boolean; Virtual;
     procedure DoThreadTerminate(Sender: TObject);virtual;
   Public
     Procedure CheckControlMessages(Wait : Boolean);
@@ -74,6 +75,7 @@ Type
 
   { TDaemon }
   TCustomControlCodeEvent = Procedure(Sender : TCustomDaemon; ACode : DWord; Var Handled : Boolean) of object;
+  TCustomControlCodeEvEvent = Procedure(Sender : TCustomDaemon; ACode, AEventType : DWord; AEventData : Pointer; Var Handled : Boolean) of object;
 
   TDaemon = Class(TCustomDaemon)
   private
@@ -83,6 +85,7 @@ Type
     FBeforeUnInstall: TDaemonEvent;
     FOnContinue: TDaemonOKEvent;
     FOnCustomControl: TCustomControlCodeEvent;
+    FOnCustomControlEvent: TCustomControlCodeEvEvent;
     FOnExecute: TDaemonEvent;
     FOnPause: TDaemonOKEvent;
     FOnShutDown: TDaemonEvent;
@@ -97,6 +100,7 @@ Type
     Function ShutDown : Boolean; override;
     Function Install : Boolean; override;
     Function UnInstall: boolean; override;
+    Function HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer) : Boolean; override;
     Function HandleCustomCode(ACode : DWord) : Boolean; Override;
   Public
     Property Definition;
@@ -113,6 +117,7 @@ Type
     Property BeforeUnInstall : TDaemonEvent Read FBeforeUnInstall Write FBeforeUnInstall;
     Property AfterUnInstall : TDaemonEvent Read FAfterUnInstall Write FAfterUnInstall;
     Property OnControlCode : TCustomControlCodeEvent Read FOnCustomControl Write FOnCustomControl;
+    Property OnControlCodeEvent : TCustomControlCodeEvEvent Read FOnCustomControlEvent Write FOnCustomControlEvent;
   end;
 
   { TDaemonController }
@@ -175,10 +180,27 @@ Type
   end;
 
 
+  TWinControlCode = (
+    wccNetBindChange,
+    wccParamChange,
+    wccPreShutdown,
+    wccShutdown,
+    wccHardwareProfileChange,
+    wccPowerEvent,
+    wccSessionChange,
+    { Windows 7 + }
+    wccTimeChange,
+    wccTriggerEvent,
+    { Windows 8 + }
+    wccUserModeReboot
+  );
+  TWinControlCodes = set of TWinControlCode;
+
   { TWinBindings }
 
   TWinBindings = class(TPersistent)
   private
+    FAcceptedCodes: TWinControlCodes;
     FDependencies: TDependencies;
     FErrCode: DWord;
     FErrorSeverity: TErrorSeverity;
@@ -207,6 +229,7 @@ Type
     Property IDTag : DWord Read FTagID Write FTagID;
     Property ServiceType : TServiceType Read FServiceType Write FServiceType;
     Property ErrorSeverity : TErrorSeverity Read FErrorSeverity Write FErrorSeverity;
+    Property AcceptedCodes : TWinControlCodes Read FAcceptedCodes Write FAcceptedCodes;
   end;
 
   { TDaemonDef }
@@ -311,7 +334,7 @@ Type
     FDaemon : TCustomDaemon;
   Protected
     procedure StartServiceExecute; virtual;
-    procedure HandleControlCode(ACode : DWord); virtual;
+    procedure HandleControlCode(ACode, AEventType : DWord; AEventData: Pointer); virtual;
   Public
     Constructor Create(ADaemon : TCustomDaemon);
     Procedure Execute; override;
@@ -614,6 +637,15 @@ begin
     FAfterUnInstall(Self)
 end;
 
+function TDaemon.HandleCustomCode(ACode, AEventType : DWord; AEventData : Pointer): Boolean;
+begin
+  Result:=Assigned(FOnCustomControlEvent);
+  If Result then
+    FOnCustomControlEvent(Self,ACode,AEventType,AEventData,Result);
+  If not Result then
+    Result:=HandleCustomCode(ACode);
+end;
+
 function TDaemon.HandleCustomCode(ACode: DWord): Boolean;
 begin
   Result:=Assigned(FOnCustomControl);
@@ -695,6 +727,11 @@ begin
   Result:=False
 end;
 
+function TCustomDaemon.HandleCustomCode(ACode, AEventType: DWord; AEventData: Pointer): Boolean;
+begin
+  Result:=HandleCustomCode(ACode);
+end;
+
 procedure TCustomDaemon.DoThreadTerminate(Sender: TObject);
 begin
   Self.FThread := NIL;
@@ -1252,7 +1289,7 @@ begin
 end;
 
 
-procedure TDaemonThread.HandleControlCode(ACode : DWord);
+procedure TDaemonThread.HandleControlCode(ACode, AEventType : DWord; AEventData : Pointer);
 
 Var
   CS : TCurrentStatus;
@@ -1273,7 +1310,7 @@ begin
       SERVICE_CONTROL_INTERROGATE : OK:=InterrogateDaemon;
     else
       CC:=True;
-      FDaemon.HandleCustomCode(ACode);
+      FDaemon.HandleCustomCode(ACode, AEventType, AEventData);
     end;
     If not OK then
       FDaemon.Status:=CS;

packages/fcl-extra/src/unix/daemonapp.inc

@@ -180,7 +180,7 @@ procedure TDaemonController.Controller(ControlCode, EventType: DWord;
 
 begin
   // Send control code to daemon thread.
-  TDaemonThread(Daemon.DaemonThread).HandleControlCode(ControlCode);
+  TDaemonThread(Daemon.DaemonThread).HandleControlCode(ControlCode, 0, Nil);
 end;
 
 function TDaemonController.ReportStatus: Boolean;

packages/fcl-extra/src/win/daemonapp.inc

@@ -445,6 +445,15 @@ end;
   TDaemonThread
   ---------------------------------------------------------------------}
 
+
+type
+  TMessageRec = record
+    EventType: DWord;
+    EventData: Pointer;
+  end;
+  PMessageRec = ^TMessageRec;
+
+
 procedure TDaemonThread.StartServiceExecute;
 
 Var
@@ -475,8 +484,13 @@ begin
         begin
         If (Msg.hwnd<>0) or (Msg.Message<>CM_SERVICE_CONTROL_CODE) then
           DispatchMessage(Msg)
+        else if (Msg.Message=CM_SERVICE_CONTROL_CODE) then
+        begin
+          HandleControlCode(Msg.wParam, PMessageRec(Msg.lParam)^.EventType, PMessageRec(Msg.lParam)^.EventData);
+          System.Dispose(PMessageRec(Msg.lParam));
+        end
         else
-          HandleControlCode(Msg.wParam);
+          HandleControlCode(Msg.wParam, 0, Nil);
         end;
       end;
   Until StopLoop;
@@ -524,21 +538,36 @@ procedure TDaemonController.Controller(ControlCode, EventType: DWord;
 
 Var
   TID : THandle;
-
+  msg: PMessageRec;
 begin
   if Assigned(FDaemon.FThread) then
     begin
     TID:=FDaemon.FThread.ThreadID;
     If FDaemon.FThread.Suspended then
       FDaemon.FThread.Resume;
-    PostThreadMessage(TID,CM_SERVICE_CONTROL_CODE,ControlCode,EventType);
+    New(msg);
+    msg^.EventType := EventType;
+    msg^.EventData := EventData;
+    PostThreadMessage(TID,CM_SERVICE_CONTROL_CODE,ControlCode,LPARAM(msg));
     end;
 end;
 
 
 function TDaemonController.ReportStatus: Boolean;
 
-  Function GetAcceptedCodes : Integer;
+  Function GetAcceptedCodes(ACodes : TWinControlCodes) : Integer;
+
+    function IsWindows7OrNewer: Boolean; inline;
+    begin
+      Result := (Win32MajorVersion > 6) or
+                ((Win32MajorVersion = 6) and (Win32MinorVersion >= 1));
+    end;
+
+    function IsWindows8OrNewer: Boolean; inline;
+    begin
+      Result := (Win32MajorVersion > 6) or
+                ((Win32MajorVersion = 6) and (Win32MinorVersion >= 2));
+    end;
 
   begin
     Result := SERVICE_ACCEPT_SHUTDOWN;
@@ -546,6 +575,26 @@ function TDaemonController.ReportStatus: Boolean;
       Result := Result or SERVICE_ACCEPT_STOP;
     if doAllowPause in FDAemon.Definition.Options then
       Result := Result or SERVICE_ACCEPT_PAUSE_CONTINUE;
+    if wccNetBindChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_NETBINDCHANGE;
+    if wccParamChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_PARAMCHANGE;
+    if wccPreShutdown in ACodes then
+      Result := Result or SERVICE_ACCEPT_PRESHUTDOWN;
+    if wccShutdown in ACodes then
+      Result := Result or SERVICE_ACCEPT_SHUTDOWN;
+    if wccHardwareProfileChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_HARDWAREPROFILECHANGE;
+    if wccPowerEvent in ACodes then
+      Result := Result or SERVICE_ACCEPT_POWEREVENT;
+    if wccSessionChange in ACodes then
+      Result := Result or SERVICE_ACCEPT_SESSIONCHANGE;
+    if (wccTimeChange in ACodes) and IsWindows7OrNewer then
+      Result := Result or SERVICE_ACCEPT_TIMECHANGE;
+    if (wccTriggerEvent in ACodes) and IsWindows8OrNewer then
+      Result := Result or SERVICE_ACCEPT_TRIGGEREVENT;
+    if (wccUserModeReboot in ACodes) and IsWindows8OrNewer then
+      Result := Result or SERVICE_ACCEPT_USERMODEREBOOT;
   end;
 
 Var
@@ -592,7 +641,7 @@ begin
     if (FDaemon.Status=csStartPending) then
       dwControlsAccepted := 0
     else
-      dwControlsAccepted := GetAcceptedCodes;
+      dwControlsAccepted := GetAcceptedCodes(WB.AcceptedCodes);
     if (FDaemon.Status in PendingStatus) and (FDaemon.Status = LastStatus) then
       Inc(FCheckPoint)
     else