0a1 > 5c6 < { Copyright(c) 1995-2010 Embarcadero Technologies, Inc. } --- > { Copyright(c) 1995-2013 Embarcadero Technologies, Inc. } 7a9,71 > { } > { Portions created by Arno Garrels } > { are Copyright (c) 2006-2013 Arno Garrels. } > { } > { ******* You may NOT distribute this unit! ******* } > { ******* Distribute the diff file only! ******* } > { The diff file is available in the download package } > { URL: http://www.duodata.de/misc/delphi/DDService.zip } > { } > { Enhanced NT Service Framework: } > { - Win 2000 FailureOptions and FailureActions, } > { Service Description. } > { HandlerEx extended service controls: } > { ParamChange, NetBindChange. } > { - Optional console control handler } > { Optional device events as well as power events. } > { Assigning one of those events will create a window } > { in the context of the service thread. } > { This window is also created when option } > { eoSynchronizeConsoleEvents is set. } > { - Win XP SessionChange service control } > { - Win Vista PreShutdown service control and } > { NonCrashFailures, Service SID Info, Required } > { Privileges and StartType AutoDelayed. } > { } > { Revision History: } > { 06 March 07 Removed calls to Classes.(De)AllocateHwnd } > { since they are not thread-safe. Made WndProc virtual. } > { 08 Sept 07 New event OnRunException. } > { 17 Oct, 08 New property ServiceName. Fixed a major } > { (CodeGear) bug in TDDService.ReportStatus. } > { As a result it is now possible to delay Vista system } > { shutdown in event OnPreshutdown. Also random } > { ERangeErrors in function ReportStatus are now gone. } > { Delphi 2009 compatibility added. } > { - V1.4 03 Nov, 2008 - } > { The image path is now enclosed in double quotes if it } > { includes spaces. Added const WM_USER_DDSERVICE that } > { should be used as a base to create custom message IDs } > { for custom messages to be sent to the service window. } > { } > { - V1.5 August 2011 - } > { Added support for Delphi XE2 } > { Added support for C++ Builder 2006 - XE2 } > { } > { - V1.6 August 2012 - } > { Added support for Delphi and C++ Builder XE3 } > { - V1.7 April 2013 - } > { Added support for Delphi and C++ Builder XE4 } > { } > {*******************************************************} > > unit DDSvcMgr; > > {$I DDCompilers.inc} > > {$IFDEF COMPILER6_UP} > {$WARN SYMBOL_PLATFORM OFF} > {$WARN SYMBOL_LIBRARY OFF} > {$IFDEF COMPILER14_UP} > {$WARN SYMBOL_DEPRECATED OFF} // TThread.Resume Suspend > {$ENDIF} > {$ENDIF} 9c73 < unit SvcMgr; --- > {$DEFINE COMPATIBILITY} 14a79,91 > {$IFDEF VER_UNKNOWN} > {$MESSAGE WARN 'You are compiling DDService with an unknown compiler version.'} > {$ENDIF} > > {$IFDEF COMPILER16_UP} > uses > Winapi.Windows, Winapi.Messages, Winapi.WinSvc, System.SysUtils, > System.Classes, DDWindows, DDWinSvc, > {$IFDEF COMPILER17_UP} > System.UITypes, > {$ENDIF} > DDSvcConsts; > {$ELSE} 16,19c93,103 < {$IF DEFINED(CLR)} < System.Security.Permissions, System.ComponentModel.Design.Serialization, < {$IFEND} < Windows, Messages, WinSvc, SysUtils, Classes; --- > Windows, Messages, WinSvc, SysUtils, Classes, > {$IFNDEF COMPILER6_UP} > Forms, > {$ENDIF} > DDWindows, DDWinSvc, DDSvcConsts; > {$ENDIF} > > const > CUSTOMCONTROL_LOW = 128; > CUSTOMCONTROL_HIGH = 255; > DEFAULT_PRESHUTDOWN_TIMEOUT = 180000; 24a109,113 > {$IFNDEF COMPATIBILITY} > TEventLogType = (etError, etWarning, etInformation, etAuditSuccess, > etAuditFailure); > {$ENDIF} > 28,32c117 < FEventLog: Integer; < {$IF DEFINED(CLR)} < strict protected < procedure Finalize; override; < {$IFEND} --- > FEventLog: THandle; 36c121,126 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType = etError; > {$ELSE} > EventType: DWord = EVENTLOG_ERROR_TYPE; > {$ENDIF} 71c161,164 < CM_SERVICE_CONTROL_CODE = WM_USER + 1; --- > CM_SERVICE_CONTROL_CODE = WM_USER + 1; // Posted to service thread > //CM_SERVICE_CONTROL_SESSIONCHANGE = WM_USER + 2; // Moved to implementation section > //CM_SERVICE_CONSOLE_CTRL = WM_USER + 3; // Moved to implementation section > WM_USER_DDSERVICE = WM_USER + 4; // First available custom ID, see implementation 75c168 < TService = class; --- > TDDService = class; 77,79d169 < {$IF DEFINED(CLR)} < TServiceThread = class(TWin32Thread) < {$ELSE} 81d170 < {$IFEND} 83c172 < FService: TService; --- > FService: TDDService; 86,88c175 < {$IF DEFINED(CLR)} < property Terminated; < {$IFEND} --- > 90c177 < constructor Create(Service: TService); --- > constructor Create(Service: TDDService); 94c181 < { TService } --- > { TFailureAction } 96,102c183 < {$IF DEFINED(CLR)} < TServiceController = WinSvc.THandlerFunction; < {$ELSE} < // WinSvc.THandlerFunction is declared as TFarProc so we need to declare < // the actual signature here to maintain backwards compatiblity. < TServiceController = procedure(CtrlCode: DWord); stdcall; < {$IFEND} --- > TFailureActionType = (faNone, faRestart, faReboot, faRunCommand); 104c185,198 < TServiceType = (stWin32, stDevice, stFileSystem); --- > TFailureAction = class(TCollectionItem) > private > FActionType: TFailureActionType; > FDelay: Integer; // milliseconds > procedure SetDelay(Value: Integer); > procedure SetActionType(Value: TFailureActionType); > protected > function GetDisplayName: String; override; > public > procedure Assign(Source: TPersistent); override; > published > property ActionType: TFailureActionType read FActionType write SetActionType; > property Delay: Integer read FDelay write SetDelay; > end; 106,107c200 < TCurrentStatus = (csStopped, csStartPending, csStopPending, csRunning, < csContinuePending, csPausePending, csPaused); --- > { TFailureActions } 109c202,212 < TErrorSeverity = (esIgnore, esNormal, esSevere, esCritical); --- > TFailureActions = class(TCollection) > private > FOwner: TPersistent; > protected > function GetItems(Index: Integer): TFailureAction; > public > function GetOwner: TPersistent; override; > function Add: TFailureAction; > constructor Create(AOwner: TPersistent); > property Items[Index: Integer]: TFailureAction read GetItems; default; > end; 111c214 < TStartType = (stBoot, stSystem, stAuto, stManual, stDisabled); --- > { TFailureOptions } 113,117c216,264 < TServiceEvent = procedure(Sender: TService) of object; < TContinueEvent = procedure(Sender: TService; var Continued: Boolean) of object; < TPauseEvent = procedure(Sender: TService; var Paused: Boolean) of object; < TStartEvent = procedure(Sender: TService; var Started: Boolean) of object; < TStopEvent = procedure(Sender: TService; var Stopped: Boolean) of object; --- > TFailureOptions = class(TPersistent) > private > FResetPeriod: Integer; // milliseconds > FRebootMessage: String; > FCommand: String; > FNonCrashFailures: Boolean; // Vista only > public > procedure Assign(Source: TPersistent); override; > constructor Create; > published > property ResetPeriod: Integer read FResetPeriod write FResetPeriod default -1; > property RebootMessage: String read FRebootMessage write FRebootMessage; > property Command: String read FCommand write FCommand; > property NonCrashFailures: Boolean read FNonCrashFailures write FNonCrashFailures default False; > end; > > { TDDService } > > {$IFDEF WIN64} > TDDIntPtr = type Int64; > {$ELSE} > TDDIntPtr = type Integer; > {$ENDIF} > > TExOptions = set of (eoForceServiceThreadWindow, eoSynchronizeConsoleEvents, > eoSuspendServiceThreadOnPause); > TServiceSidType = (stNone, stUnrestricted, stRestricted); > TAllowedExControls = set of (alParamChange, alNetBindChange, alSessionChange, > alPreShutdown); > TServiceControllerEx = function(CtrlCode, EventType: DWord; > EventData, Context: Pointer): DWord; stdcall; > TServiceConsoleCtrlHandler = function(Ctrl: DWord): Bool; stdcall; > TServiceController = procedure(CtrlCode: DWord); stdcall; > TServiceType = (stWin32, stDevice, stFileSystem); > TCurrentStatus = (csStopped, csStartPending, csStopPending, csRunning, > csContinuePending, csPausePending, csPaused); > TErrorSeverity = (esIgnore, esNormal, esSevere, esCritical); > TStartType = (stBoot, stSystem, stAuto, stManual, stDisabled, stAutoDelayed); > TServiceEvent = procedure(Sender: TDDService) of object; > TContinueEvent = procedure(Sender: TDDService; var Continued: Boolean) of object; > TPauseEvent = procedure(Sender: TDDService; var Paused: Boolean) of object; > TStartEvent = procedure(Sender: TDDService; var Started: Boolean) of object; > TStopEvent = procedure(Sender: TDDService; var Stopped: Boolean) of object; > TSessionChangeEvent = procedure (Sender: TDDService; EventType, SessionID: Integer) of object; > TCustomControlEvent = procedure(Sender: TDDService; CtrlCode: Integer) of object; > TConsoleEvent = procedure(Sender: TDDService; CtrlCode: Integer; var Handled: Boolean) of object; > TControlEvent = procedure(Sender: TDDService; EventType: Integer) of object; > TMessageEvent = procedure(Sender: TDDService; EventType: Integer; EventData: TDDIntPtr; var MsgResult: Integer) of object; > TServiceExceptionEvent = procedure(Sender: TObject; E: Exception; var LogDefaultErrMsg, CanAbort: Boolean) of object; 119,120c266 < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] < TService = class(TDataModule) --- > TDDService = class(TDataModule) 121a268 > FServiceStatus: TServiceStatus; 123a271,273 > FAllowedExControls: TAllowedExControls; > FConsoleHandler: Pointer; > FPreShutdownTimeout: Integer; 124a275 > FDescription: String; 125a277 > FServiceName: String; 128a281,282 > FFailureActions: TFailureActions; > FFailureOptions: TFailureOptions; 129a284 > FImagePath: String; 132a288 > FRequiredPrivileges: TStrings; 134a291 > FExOptions: TExOptions; 135a293 > FServiceSidType: TServiceSidType; 139a298 > FServiceWindow: Hwnd; 145a305 > FTriggerStarted: Boolean; 146a307 > FOnDeviceEvent: TMessageEvent; 147a309,310 > //FOnHardwareProfileChange: TMessageEvent; > FOnNetBindChange: TControlEvent; 148a312 > FOnPowerEvent: TMessageEvent; 149a314,315 > FOnPreShutdown: TServiceEvent; > FOnParamChange: TServiceEvent; 151a318,321 > FOnSessionChange: TSessionChangeEvent; > FOnCustomControl: TCustomControlEvent; > FOnConsoleEvent: TConsoleEvent; > FOnRunException: TServiceExceptionEvent; 152a323,324 > function GetServiceName: String; > procedure SetServiceName(const Value: String); 158,161c330,333 < function GetNTServiceType: Integer; < function GetNTStartType: Integer; < function GetNTErrorSeverity: Integer; < function GetNTControlsAccepted: Integer; --- > function GetNTServiceType: DWORD; > function GetNTStartType: DWORD; > function GetNTErrorSeverity: DWORD; > function GetNTControlsAccepted: DWORD; 164a337 > procedure SetOnConsoleEvent(Value: TConsoleEvent); 166a340,342 > function AreFailureActionsStored: Boolean; > procedure SetFailureOptions(Value: TFailureOptions); > procedure SetFailureActions(Value: TFailureActions); 169a346,358 > procedure SetDescription(const Value: String); > procedure SetOnPreShutDown(Value: TServiceEvent); > procedure SetOnParamChange(Value: TServiceEvent); > procedure SetOnSessionChange(Value: TSessionChangeEvent); > procedure SetRequiredPrivileges(Value: TStrings); > procedure SetOnNetBindChange(Value: TControlEvent); > procedure SetExOptions(Value: TExOptions); > procedure SetOnPowerEvent(Value: TMessageEvent); > procedure SetOnDeviceEvent(Value: TMessageEvent); > procedure CheckCreateServiceThreadWindow; > procedure DestroyServiceThreadWindow; > function AllocateHWnd: HWND; > procedure DeallocateHWnd(WndHandle: HWND); 170a360,364 > {$IFDEF COMPILER16_UP} > procedure Main(Argc: DWord; Argv: PLPWSTR); > {$ELSE} > procedure Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 171a366,367 > function ControllerEx(CtrlCode, EventType: DWord; EventData, Context: Pointer): DWord; > function ConsoleCtrlHandler(Ctrl: DWord): LongBool; 173,175c369,371 < function DoStop: Boolean; virtual; < function DoPause: Boolean; virtual; < function DoContinue: Boolean; virtual; --- > function DoStop: Boolean; virtual; > function DoPause: Boolean; virtual; > function DoContinue: Boolean; virtual; 178,183c374,385 < function DoCustomControl(CtrlCode: DWord): Boolean; virtual; < {$IF DEFINED(CLR)} < procedure Main(Argc: DWord; Argv: IntPtr); < {$ELSE} < procedure Main(Argc: DWord; Argv: PLPSTR); < {$IFEND} --- > procedure DoCustomControl(CtrlCode: DWord); virtual; > function DoDeviceEvent(EventType: Integer; EventData: TDDIntPtr): Integer; virtual; > //function DoHardwareProfileChange(EventType: Integer): Integer; virtual; > function DoRunException(E: Exception; var CanAbort: Boolean): Boolean; virtual; > procedure DoNetBindChange(EventType: Integer); virtual; > procedure DoSessionChange(EventType, SessionID: Integer); virtual; > function DoPowerEvent(EventType: Integer; EventData: TDDIntPtr): Integer; virtual; > function DoConsoleEvent(CtrlCode: Integer): Boolean; virtual; > procedure DoParamChange; virtual; > procedure DoPreShutdown; virtual; > function ThreadWindowNeeded: Boolean; virtual; > procedure WndProc(var MsgRec: TMessage); virtual; 184a387 > constructor Create(AOwner: TComponent); override; 187a391,392 > function GetServiceControllerEx: TServiceControllerEx; virtual; abstract; > function GetConsoleCtrlHandler: TServiceConsoleCtrlHandler; virtual; abstract; 189c394 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; {$IFNDEF COMPATIBILITY}EventType: TEventLogType = etError;{$ELSE}EventType: DWord = 1;{$ENDIF} 190a396 > procedure Stop; 191a398 > property ImagePath: String read FImagePath write FImagePath; 196a404,405 > property TriggerStarted: Boolean read FTriggerStarted; > property ServiceWindow: HWND read FServiceWindow; 200a410 > property AllowedExControls: TAllowedExControls read FAllowedExControls write FAllowedExControls default []; 202c412,414 < property DisplayName: String read GetDisplayName write FDisplayName; --- > property DisplayName: String read GetDisplayName write FDisplayName {stored False}; > property ServiceName: String read GetServiceName write SetServiceName {stored False}; > property Description: String read FDescription write SetDescription; 203a416,418 > property ExOptions: TExOptions read FExOptions write SetExOptions default [eoSuspendServiceThreadOnPause]; > property FailureOptions: TFailureOptions read FFailureOptions write SetFailureOptions; > property FailureActions: TFailureActions read FFailureActions write SetFailureActions stored AreFailureActionsStored; 206a422,423 > property PreShutdownTimeout: Integer read FPreShutdownTimeout write FPreShutdownTimeout default DEFAULT_PRESHUTDOWN_TIMEOUT; > property RequiredPrivileges: TStrings read FRequiredPrivileges write SetRequiredPrivileges; 209a427 > property ServiceSidType: TServiceSidType read FServiceSidType write FServiceSidType default stNone; 216a435 > property OnDeviceEvent: TMessageEvent read FOnDeviceEvent write SetOnDeviceEvent; 217a437,438 > property OnNetBindChange: TControlEvent read FOnNetBindChange write SetOnNetBindChange; > property OnParamChange: TServiceEvent read FOnParamChange write SetOnParamChange; 218a440,441 > property OnPowerEvent: TMessageEvent read FOnPowerEvent write SetOnPowerEvent; > property OnRunException: TServiceExceptionEvent read FOnRunException write FOnRunException; 221a445,448 > property OnSessionChange: TSessionChangeEvent read FOnSessionChange write SetOnSessionChange; > property OnCustomControl : TCustomControlEvent read FOnCustomControl write FOnCustomControl; > property OnConsoleEvent: TConsoleEvent read FOnConsoleEvent write SetOnConsoleEvent; > property OnPreShutdown: TServiceEvent read FOnPreShutdown write SetOnPreShutdown; 226,227c453,454 < [RootDesignerSerializerAttribute('', '', False)] < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] --- > TExceptionEvent = procedure(Sender: TObject; E: Exception; var Handled: Boolean) of object; > 233a461 > FOnException: TExceptionEvent; 239,242c467,469 < function Hook(var Message: TMessage): Boolean; < {$IF DEFINED(CLR)} < procedure DispatchServiceMain(Argc: DWord; Argv: IntPtr); < {$ELSE} --- > {$IFDEF COMPILER16_UP} > procedure DispatchServiceMain(Argc: DWord; Argv: PLPWSTR); > {$ELSE} 244c471,473 < {$IFEND} --- > {$ENDIF} > function Hook(var Message: TMessage): Boolean; > procedure ChangeServiceConfiguration2(Service: TDDService; hService: THandle); {virtual;} 249a479 > property EventLogger: TEventLogger read FEventLogger; 255a486 > property OnException: TExceptionEvent read FOnException write FOnException; 257a489,490 > function IsValidServiceName(const SvcName: string): Boolean; > 262a496,502 > {$IFDEF COMPILER16_UP} > uses > {$IFDEF COMPILER6_UP} > Vcl.Forms, > {$ENDIF} > Vcl.Dialogs, Vcl.Consts; > {$ELSE} 264,267c504,603 < {$IF DEFINED(CLR)} < System.Runtime.InteropServices, System.IO, < {$IFEND} < Forms, Dialogs, Consts; --- > {$IFDEF COMPILER6_UP} > Forms, > {$ENDIF} > Dialogs, Consts; > {$ENDIF} > > const > CM_SERVICE_CONTROL_SESSIONCHANGE = WM_USER + 2; // Posted to service thread > CM_SERVICE_CONSOLE_CTRL = WM_USER + 3; // Sent to ServiceWindow > ActionTypes: array[TFailureActionType] of SC_ACTION_TYPE = > (SC_ACTION_NONE, SC_ACTION_RESTART, > SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND); > {$IFNDEF COMPATIBILITY} > EventLogTypes : array[etError..etAuditFailure] of DWord = ( > EVENTLOG_ERROR_TYPE, EVENTLOG_WARNING_TYPE, > EVENTLOG_INFORMATION_TYPE, EVENTLOG_AUDIT_SUCCESS, > EVENTLOG_AUDIT_FAILURE); > {$ENDIF} > WndClassName: PChar = 'ServiceThreadWndClass'; > > var > WndCnt: Integer = 0; > CritSectWndClass: TRtlCriticalSection; > { > function CtrlCodeToStr(Ctrl: DWord): String; > begin > case Ctrl of > SERVICE_CONTROL_STOP : Result := 'SERVICE_CONTROL_STOP'; > SERVICE_CONTROL_PAUSE : Result := 'SERVICE_CONTROL_PAUSE'; > SERVICE_CONTROL_CONTINUE : Result := 'SERVICE_CONTROL_CONTINUE'; > SERVICE_CONTROL_INTERROGATE : Result := 'SERVICE_CONTROL_INTERROGATE'; > SERVICE_CONTROL_SHUTDOWN : Result := 'SERVICE_CONTROL_SHUTDOWN'; > SERVICE_CONTROL_PARAMCHANGE : Result := 'SERVICE_CONTROL_PARAMCHANGE'; > SERVICE_CONTROL_NETBINDADD : Result := 'SERVICE_CONTROL_NETBINDADD'; > SERVICE_CONTROL_NETBINDREMOVE : Result := 'SERVICE_CONTROL_NETBINDREMOVE'; > SERVICE_CONTROL_NETBINDENABLE : Result := 'SERVICE_CONTROL_NETBINDENABLE'; > SERVICE_CONTROL_NETBINDDISABLE : Result := 'SERVICE_CONTROL_NETBINDDISABLE'; > SERVICE_CONTROL_DEVICEEVENT : Result := 'SERVICE_CONTROL_DEVICEEVENT'; > SERVICE_CONTROL_HARDWAREPROFILECHANGE : Result := 'SERVICE_CONTROL_HARDWAREPROFILECHANGE'; > SERVICE_CONTROL_POWEREVENT : Result := 'SERVICE_CONTROL_POWEREVENT'; > SERVICE_CONTROL_SESSIONCHANGE : Result := 'SERVICE_CONTROL_SESSIONCHANGE'; > SERVICE_CONTROL_PRESHUTDOWN : Result := 'SERVICE_CONTROL_PRESHUTDOWN'; > else > Result := 'Unknown_Control'; > end; > end; > } > function IsWin2K: Boolean; {$IFDEF USE_INLINE} inline; {$ENDIF} > begin > Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5); > end; > > function IsWinXP: Boolean; {$IFDEF USE_INLINE} inline; {$ENDIF} > begin > Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and > (((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or > (Win32MajorVersion > 5)); > end; > > function IsWinVista: Boolean; {$IFDEF USE_INLINE} inline; {$ENDIF} > begin > Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 6) > end; > > function IsWin7: Boolean; {$IFDEF USE_INLINE} inline; {$ENDIF} > begin > Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and > (((Win32MajorVersion = 6) and (Win32MinorVersion >= 1)) or > (Win32MajorVersion > 6)); > end; > > function StrToMultiSZ(AStrings: TStrings): String; > var > I, Len: Integer; > P: PChar; > begin > Result := ''; > Len := 0; > for I := 0 to AStrings.Count - 1 do > Inc(Len, Length(AStrings[I]) + 1); // For null-terminator > if Len <> 0 then > begin > Inc(Len); // For final null-terminator; > SetLength(Result, Len); > P := @Result[1]; > for I := 0 to AStrings.Count - 1 do > begin > P := StrECopy(P, PChar(AStrings[I])); > Inc(P); > end; > P^ := #0; > end; > end; > > {$IFNDEF COMPILER6_UP} > procedure RaiseLastOSError; > begin > RaiseLastWin32Error; > end; > {$ENDIF} 278,286d613 < {$IF DEFINED(CLR)} < procedure TEventLogger.Finalize; < begin < if FEventLog <> 0 then < DeregisterEventSource(FEventLog); < inherited; < end; < {$IFEND} < 294,296d620 < {$IF DEFINED(CLR)} < System.GC.SuppressFinalize(self); < {$IFEND} 300,320c624,626 < procedure TEventLogger.LogMessage(Message: String; EventType: DWord; < Category: Word; ID: DWord); < {$IF DEFINED(CLR)} < var < P, PP: IntPtr; < begin < if FEventLog = 0 then < FEventLog := RegisterEventSource(nil, FName); < P := Marshal.StringToHGlobalAuto(Message); < try < PP := Marshal.AllocHGlobal(SizeOf(IntPtr)); < try < Marshal.WriteIntPtr(PP, P); < ReportEvent(FEventLog, EventType, Category, ID, nil, 1, 0, PP, nil); < finally < Marshal.FreeHGlobal(PP); < end; < finally < Marshal.FreeHGlobal(P); < end; < end; --- > procedure TEventLogger.LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType; 321a628,630 > EventType: DWord; > {$ENDIF} > Category: Word; ID: DWord); 323c632 < P: Pointer; --- > PMsg: Pointer; 325c634 < P := PChar(Message); --- > PMsg := PChar(Msg); 328c637,642 < ReportEvent(FEventLog, EventType, Category, ID, nil, 1, 0, @P, nil); --- > {$IFNDEF COMPATIBILITY} > ReportEvent(FEventLog, EventLogTypes[EventType], > Category, ID, nil, 1, 0, @PMsg, nil); > {$ELSE} > ReportEvent(FEventLog, EventType, Category, ID, nil, 1, 0, @PMsg, nil); > {$ENDIF} 330d643 < {$IFEND} 366c679,683 < constructor TServiceThread.Create(Service: TService); --- > function ThreadWindowProc(aWnd: HWND; aMsg: UINT; aWParam: WPARAM; > aLParam: LPARAM): LRESULT; stdcall; > var > Obj: TObject; > MsgRec: TMessage; 368,370c685,686 < {$IF DEFINED(CLR)} < inherited Create(True); < FService := Service; --- > {$IFDEF WIN64} > Obj := TObject(GetWindowLongPtr(aWnd, 0)); 371a688,768 > Obj := TObject(GetWindowLong(aWnd, 0)); > {$ENDIF} > if not (Obj is TDDService) then > Result := DefWindowProc(aWnd, aMsg, aWParam, aLParam) > else begin > MsgRec.Msg := aMsg; > MsgRec.WParam := aWParam; > MsgRec.LParam := aLParam; > MsgRec.Result := 0; > TDDService(Obj).WndProc(MsgRec); > Result := MsgRec.Result; > end; > end; > > function TDDService.AllocateHWnd : HWND; > var > WndClass: TWndClass; > Res: Hwnd; > begin > Result := 0; > EnterCriticalSection(CritSectWndClass); > try > if not GetClassInfo(HInstance, WndClassName, WndClass) then > begin > ZeroMemory(@WndClass, SizeOf(TWndClass)); > with WndClass do > begin > lpfnWndProc := @ThreadWindowProc; > cbWndExtra := SizeOf(Pointer); > hInstance := SysInit.HInstance; > lpszClassName := WndClassName; > end; > {$IFDEF COMPILER16_UP} > Res := Winapi.Windows.RegisterClass(WndClass); > {$ELSE} > Res := Windows.RegisterClass(WndClass); > {$ENDIF} > if Res = 0 then > Exit; > end; > Res := CreateWindowEx(WS_EX_TOOLWINDOW, WndClassName, > '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil); > if Res = 0 then > Exit; > {$IFDEF WIN64} > SetWindowLongPtr(Res, 0, INT_PTR(Self)); > {$ELSE} > SetWindowLong(Res, 0, Integer(Self)); > {$ENDIF} > Inc(WndCnt); > Result := Res; > finally > LeaveCriticalSection(CritSectWndClass); > end; > end; > > procedure TDDService.DeallocateHWnd(WndHandle: HWND); > begin > EnterCriticalSection(CritSectWndClass); > try > if WndHandle = 0 then Exit; > {$IFDEF WIN64} > SetWindowLongPtr(WndHandle, 0, 0); > {$ELSE} > SetWindowLong(WndHandle, 0, 0); > {$ENDIF} > DestroyWindow(WndHandle); > Dec(WndCnt); > if WndCnt <= 0 then > {$IFDEF COMPILER16_UP} > Winapi.Windows.UnregisterClass(WndClassName, HInstance); > {$ELSE} > Windows.UnregisterClass(WndClassName, HInstance); > {$ENDIF} > finally > LeaveCriticalSection(CritSectWndClass); > end; > end; > > constructor TServiceThread.Create(Service: TDDService); > begin 374d770 < {$IFEND} 391,392c787,788 < if Assigned(FService.OnStart) then FService.OnStart(FService, Started); < if not Started then Exit; --- > if FService.ThreadWindowNeeded then > FService.CheckCreateServiceThreadWindow; 394,402c790,809 < FService.Status := csRunning; < if Assigned(FService.OnExecute) then < FService.OnExecute(FService) < else < ProcessRequests(True); < ProcessRequests(False); < except < on E: Exception do < FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message])); --- > FService.OnConsoleEvent := FService.FOnConsoleEvent; > try > if Assigned(FService.OnStart) then FService.OnStart(FService, Started); > if not Started then Exit; > try > FService.Status := csRunning; > if Assigned(FService.OnExecute) then > FService.OnExecute(FService) > else > ProcessRequests(True); > ProcessRequests(False); > except > on E: Exception do > FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message])); > end; > finally > FService.OnConsoleEvent := nil; > end; > finally > FService.DestroyServiceThreadWindow; 411,412c818,821 < ActionStr: array[1..5] of String = (SStop, SPause, SContinue, SInterrogate, < SShutdown); --- > ActionStr: array[1..15] of String = (SStop, SPause, SContinue, SInterrogate, > SShutdown, SParamChange, SNetBindAdd, SNetBindRemove, SNetBindEnable, > SNetBindDisable, SDeviceEvent, SHardwareProfileChange, SPowerEvent, > SSessionChange, SPreShutdown); 416c825 < msg: TMsg; --- > msg: tagMSG; 419a829 > CanAbort: Boolean; 428a839 > 436,438d846 < {$IF DEFINED(CLR)} < case msg.wParam.ToInt64 of < {$ELSE} 440d847 < {$IFEND} 445a853,858 > SERVICE_CONTROL_PARAMCHANGE: FService.DoParamChange; > SERVICE_CONTROL_NETBINDADD, > SERVICE_CONTROL_NETBINDREMOVE, > SERVICE_CONTROL_NETBINDENABLE, > SERVICE_CONTROL_NETBINDDISABLE: FService.DoNetBindChange(msg.wParam); > SERVICE_CONTROL_PRESHUTDOWN: FService.DoPreShutDown; 447c860,861 < ActionOK := FService.DoCustomControl(msg.wParam); --- > {user-defined control code = Range 128 to 255 } > FService.DoCustomControl(msg.wParam); 456,464c870,879 < {$IF DEFINED(CLR)} < if msg.wParam.ToInt64 in [1..5] then < {$ELSE} < if msg.wParam in [1..5] then < {$IFEND} < ErrorMsg := Format(SServiceFailed, [ActionStr[Integer(msg.wParam)], E.Message]) < else < ErrorMsg := Format(SCustomError,[msg.wParam, E.Message]); < FService.LogMessage(ErrorMsg); --- > if FService.DoRunException(E, CanAbort) then > begin > if msg.wParam in [1..15] then > ErrorMsg := Format(SServiceFailed, [ActionStr[msg.wParam], E.Message]) > else > ErrorMsg := Format(SCustomError,[msg.wParam, E.Message]); > FService.LogMessage(ErrorMsg); > end; > if CanAbort then > Abort; 467c882,899 < end else --- > end > else if msg.message = CM_SERVICE_CONTROL_SESSIONCHANGE then > begin > try > FService.DoSessionChange(Msg.wParam, Msg.lParam); > except > on E: Exception do > begin > if FService.DoRunException(E, CanAbort) then > FService.LogMessage(Format(SServiceFailed, > [ActionStr[SERVICE_CONTROL_SESSIONCHANGE], E.Message])); > if CanAbort then > Abort; > end; > end; > end > else begin > TranslateMessage(msg); 469c901,904 < end else --- > end; > end > else begin > TranslateMessage(msg); 470a906 > end; 474c910,945 < { TService } --- > procedure TDDService.WndProc(var MsgRec: TMessage); > var > CanAbort: Boolean; > begin > try > case MsgRec.Msg of > CM_SERVICE_CONSOLE_CTRL: > MsgRec.Result := Ord(DoConsoleEvent(MsgRec.WParam)); > WM_POWERBROADCAST: > MsgRec.Result := DoPowerEvent(MsgRec.WParam, MsgRec.LParam); > WM_DEVICECHANGE: > MsgRec.Result := DoDeviceEvent(MsgRec.WParam, MsgRec.LParam); > else > MsgRec.Result := DefWindowProc(FServiceWindow, > MsgRec.Msg, MsgRec.WParam, MsgRec.LParam); > end; > except > on E: Exception do > begin > if DoRunException(E, CanAbort) then > LogMessage(Format(SServiceFailed, > ['Message $' + IntToHex(MsgRec.Msg, 8), E.Message])); > if CanAbort then > Abort; > end; > end; > end; > > { TDDService } > > constructor TDDService.Create(AOwner: TComponent); > begin > { This dummy exists only to get C++ Builder working correctly otherwise } > { some non-initialized string and set properties. } > inherited Create(AOwner); > end; 476c947 < constructor TService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); --- > constructor TDDService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); 488a960,967 > FFailureOptions := TFailureOptions.Create; > FFailureActions := TFailureActions.Create(Self); > FPreShutdownTimeout := DEFAULT_PRESHUTDOWN_TIMEOUT; > FRequiredPrivileges := TStringList.Create; > FImagePath := ExpandUNCFileName(ParamStr(0)); > if Pos(' ', FImagePath) > 0 then > FImagePath := '"' + FImagePath + '"'; > FExOptions := [eoSuspendServiceThreadOnPause]; 491c970 < destructor TService.Destroy; --- > destructor TDDService.Destroy; 495a975,977 > FFailureOptions.Free; > FFailureActions.Free; > FRequiredPrivileges.Free; 499c981 < function TService.GetDisplayName: String; --- > function TDDService.GetDisplayName: String; 507c989,1004 < procedure TService.SetInteractive(Value: Boolean); --- > function TDDService.GetServiceName: String; > begin > if FServiceName <> '' then > Result := FServiceName > else > Result := Name; > end; > > procedure TDDService.SetServiceName(const Value: String); > begin > if not IsValidServiceName(Value) then > raise Exception.CreateResFmt(@SInvalidServiceName, [Value]); > FServiceName := Value; > end; > > procedure TDDService.SetInteractive(Value: Boolean); 518c1015 < procedure TService.SetPassword(const Value: string); --- > procedure TDDService.SetPassword(const Value: String); 526c1023 < procedure TService.SetServiceStartName(const Value: string); --- > procedure TDDService.SetServiceStartName(const Value: String); 534c1031 < procedure TService.SetDependencies(Value: TDependencies); --- > procedure TDDService.SetDependencies(Value: TDependencies); 539c1036 < function TService.AreDependenciesStored: Boolean; --- > function TDDService.AreDependenciesStored: Boolean; 544c1041,1046 < function TService.GetParamCount: Integer; --- > function TDDService.AreFailureActionsStored: Boolean; > begin > Result := FFailureActions.Count > 0; > end; > > function TDDService.GetParamCount: Integer; 549c1051 < function TService.GetParam(Index: Integer): String; --- > function TDDService.GetParam(Index: Integer): String; 554c1056 < procedure TService.SetOnContinue(Value: TContinueEvent); --- > procedure TDDService.SetOnContinue(Value: TContinueEvent); 560c1062 < procedure TService.SetOnPause(Value: TPauseEvent); --- > procedure TDDService.SetOnPause(Value: TPauseEvent); 566c1068 < procedure TService.SetOnStop(Value: TStopEvent); --- > procedure TDDService.SetOnStop(Value: TStopEvent); 572c1074,1128 < function TService.GetTerminated: Boolean; --- > procedure TDDService.SetOnConsoleEvent(Value: TConsoleEvent); > begin > if Assigned(Value) then > begin > if Assigned(FServiceThread) and (FConsoleHandler = nil) then > begin > FConsoleHandler := @GetConsoleCtrlHandler(); > if not SetConsoleCtrlHandler(FConsoleHandler, True) then > begin > FConsoleHandler := nil; > RaiseLastOSError; > end; > if (eoSynchronizeConsoleEvents in FExOptions) then > CheckCreateServiceThreadWindow; > end; > end > else if Assigned(FConsoleHandler) then > begin > SetConsoleCtrlHandler(FConsoleHandler, False); > FConsoleHandler := nil; > end; > FOnConsoleEvent := Value; > end; > > procedure TDDService.SetOnParamChange(Value: TServiceEvent); > begin > FOnParamChange := Value; > FAllowedExControls := FAllowedExControls + [alParamChange]; > end; > > procedure TDDService.SetOnPowerEvent(Value: TMessageEvent); > begin > FOnPowerEvent := Value; > if Assigned(Value) then CheckCreateServiceThreadWindow; > end; > > procedure TDDService.SetOnDeviceEvent(Value: TMessageEvent); > begin > FOnDeviceEvent := Value; > if Assigned(Value) then CheckCreateServiceThreadWindow; > end; > > procedure TDDService.SetOnPreShutDown(Value: TServiceEvent); > begin > FOnPreShutdown := Value; > FAllowedExControls := FAllowedExControls + [alPreShutdown]; > end; > > procedure TDDService.SetOnSessionChange(Value: TSessionChangeEvent); > begin > FOnSessionChange := Value; > FAllowedExControls := FAllowedExControls + [alSessionChange]; > end; > > function TDDService.GetTerminated: Boolean; 579c1135 < function TService.GetNTDependencies: String; --- > function TDDService.GetNTDependencies: String; 581,586c1137 < {$IF DEFINED(CLR)} < I, J, Len: Integer; < Pos: Integer; < Temp: string; < {$ELSE} < I, Len: Integer; --- > i, Len: Integer; 588d1138 < {$IFEND} 597,621d1146 < {$IF DEFINED(CLR)} < if Len <> 0 then < begin < Inc(Len); // For final null-terminator; < SetLength(Result, Len); < Pos := 1; < for i := 0 to Dependencies.Count - 1 do < begin < if Dependencies[i].IsGroup then < begin < Result[Pos] := SC_GROUP_IDENTIFIER; < Inc(Pos); < end; < Temp := Dependencies[i].Name; < Len := Length(Temp) + 1; < SetLength(Temp, Len); // add one for null-terminator < for j := 1 to Len do < begin < Result[Pos] := Temp[j]; < Inc(Pos); < end; < end; < Result[Pos] := #0; < end; < {$ELSE} 639d1163 < {$IFEND} 643c1167 < NTServiceType: array[TServiceType] of Integer = ( SERVICE_WIN32_OWN_PROCESS, --- > NTServiceType: array[TServiceType] of DWORD = ( SERVICE_WIN32_OWN_PROCESS, 646c1170 < function TService.GetNTServiceType: Integer; --- > function TDDService.GetNTServiceType: DWORD; 656c1180 < NTStartType: array[TStartType] of Integer = (SERVICE_BOOT_START, --- > NTStartType: array[TStartType] of DWORD = (SERVICE_BOOT_START, 658c1182 < SERVICE_DISABLED); --- > SERVICE_DISABLED, SERVICE_AUTO_START); 660c1184 < function TService.GetNTStartType: Integer; --- > function TDDService.GetNTStartType: DWORD; 667c1191 < function TService.GetNTErrorSeverity: Integer; --- > function TDDService.GetNTErrorSeverity: DWORD; 669c1193 < NTErrorSeverity: array[TErrorSeverity] of Integer = (SERVICE_ERROR_IGNORE, --- > NTErrorSeverity: array[TErrorSeverity] of DWORD = (SERVICE_ERROR_IGNORE, 675c1199 < function TService.GetNTControlsAccepted: Integer; --- > function TDDService.GetNTControlsAccepted: DWORD; 679a1204,1221 > > if IsWin2K then > begin > if alParamChange in FAllowedExControls then > Result := Result or SERVICE_ACCEPT_PARAMCHANGE; > if (alNetBindChange in FAllowedExControls) then > Result := Result or SERVICE_ACCEPT_NETBINDCHANGE; > if IsWinXP then > begin > if (alSessionChange in FAllowedExControls) then > Result := Result or SERVICE_ACCEPT_SESSIONCHANGE; > if IsWinVista then > begin > if alPreShutdown in FAllowedExControls then > Result := Result or SERVICE_ACCEPT_PRESHUTDOWN; > end; > end; > end; 682c1224,1230 < procedure TService.LogMessage(Message: String; EventType: DWord; Category, ID: Integer); --- > procedure TDDService.LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType; > {$ELSE} > EventType: DWord; > {$ENDIF} > Category, ID: Integer); 685,686c1233,1234 < FEventLogger := TEventLogger.Create(Name); < FEventLogger.LogMessage(Message, EventType, Category, ID); --- > FEventLogger := TEventLogger.Create(ServiceName); > FEventLogger.LogMessage(Msg, EventType, Category, ID); 691,693c1239,1241 < NTServiceStatus: array[TCurrentStatus] of Integer = (SERVICE_STOPPED, < SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING, < SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED); --- > NTServiceStatus: array[TCurrentStatus] of DWORD = (SERVICE_STOPPED, > SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING, > SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED); 695c1243 < csContinuePending, csPausePending]; --- > csContinuePending, csPausePending]; 697,699c1245,1247 < procedure TService.ReportStatus; < var < ServiceStatus: TServiceStatus; --- > procedure TDDService.ReportStatus; > {var > ServiceStatus: TServiceStatus; } 701c1249 < with ServiceStatus do --- > with FServiceStatus do 706c1254,1255 < dwControlsAccepted := 0 else --- > dwControlsAccepted := 0 > else 707a1257 > 709c1259,1260 < Inc(dwCheckPoint) else --- > Inc(dwCheckPoint) > else 717,718c1268,1269 < if not SetServiceStatus(FStatusHandle, ServiceStatus) then < LogMessage(SysErrorMessage(GetLastError)); --- > if not SetServiceStatus(FStatusHandle, FServiceStatus) then > LogMessage('ReportStatus: ' + SysErrorMessage(GetLastError)); 722c1273 < procedure TService.SetStatus(Value: TCurrentStatus); --- > procedure TDDService.SetStatus(Value: TCurrentStatus); 729,734c1280 < {$IF DEFINED(CLR)} < procedure TService.Main(Argc: DWord; Argv: IntPtr); < var < i: Integer; < Controller: TServiceController; < PStr: IntPtr; --- > procedure TDDService.Stop; 736c1282 < for i := 0 to Argc - 1 do --- > if Assigned(ServiceThread) then 738,739c1284,1286 < PStr := Marshal.ReadIntPtr(Argv, i * SizeOf(IntPtr)); < FParams.Add(Marshal.PtrToStringAuto(PStr)); --- > if ServiceThread.Suspended then ServiceThread.Resume; > PostThreadMessage(ServiceThread.ThreadID, > CM_SERVICE_CONTROL_CODE, SERVICE_CONTROL_STOP, 0); 741,746d1287 < Controller := Self.GetServiceController(); < FStatusHandle := RegisterServiceCtrlHandler(Name, Controller); < if (FStatusHandle = 0) then < LogMessage(SysErrorMessage(GetLastError)) < else < DoStart; 747a1289,1291 > > {$IFDEF COMPILER16_UP} > procedure TDDService.Main(Argc: DWord; Argv: PLPWSTR); 749c1293,1294 < procedure TService.Main(Argc: DWord; Argv: PLPSTR); --- > procedure TDDService.Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 755c1300 < Controller: TServiceController; --- > Controller: Pointer; 759,760c1304,1314 < Controller := GetServiceController(); < FStatusHandle := RegisterServiceCtrlHandler(PChar(Name), @Controller); --- > { Windows 7 and better. Are we started by a trigger? } > FTriggerStarted := (Argc > 1) and (PPCharArray(Argv)[1] = SERVICE_TRIGGER_STARTED_ARGUMENT); > if IsWin2K then > begin > Controller := @GetServiceControllerEx(); > FStatusHandle := RegisterServiceCtrlHandlerEx(PChar(ServiceName), Controller, nil); > end > else begin > Controller := @GetServiceController(); > FStatusHandle := RegisterServiceCtrlHandler(PChar(ServiceName), Controller); > end; 766d1319 < {$IFEND} 768c1321 < procedure TService.Controller(CtrlCode: DWord); --- > procedure TDDService.Controller(CtrlCode: DWord); 770d1322 < PostThreadMessage(ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, CtrlCode, 0); 771a1324,1388 > PostThreadMessage(ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, CtrlCode, 0); > end; > > function TDDService.ControllerEx(CtrlCode, EventType: DWord; EventData, > Context: Pointer): DWord; > var > WP: WPARAM; > LP: LPARAM; > Msg: UINT; > begin > LP := 0; > Msg := CM_SERVICE_CONTROL_CODE; > WP := CtrlCode; > Result := ERROR_CALL_NOT_IMPLEMENTED; > > case CtrlCode of > SERVICE_CONTROL_CONTINUE, > SERVICE_CONTROL_PAUSE : > if FAllowPause then > Result := NO_ERROR; > > SERVICE_CONTROL_STOP : > if FAllowStop then > Result := NO_ERROR; > > SERVICE_CONTROL_INTERROGATE, > SERVICE_CONTROL_SHUTDOWN : > Result := NO_ERROR; > > SERVICE_CONTROL_PARAMCHANGE : > if alParamChange in FAllowedExControls then > Result := NO_ERROR; > > SERVICE_CONTROL_NETBINDADD, > SERVICE_CONTROL_NETBINDREMOVE, > SERVICE_CONTROL_NETBINDENABLE, > SERVICE_CONTROL_NETBINDDISABLE : > if alNetBindChange in FAllowedExControls then > Result := NO_ERROR; > > SERVICE_CONTROL_SESSIONCHANGE : > if alSessionChange in FAllowedExControls then > begin > Msg := CM_SERVICE_CONTROL_SESSIONCHANGE; > WP := EventType; > LP := PWtsSessionNotification(EventData)^.dwSessionId; > Result := NO_ERROR; > end; > > SERVICE_CONTROL_PRESHUTDOWN : > if alPreShutdown in FAllowedExControls then > Result := NO_ERROR; > > else // case > if CtrlCode in [CUSTOMCONTROL_LOW..CUSTOMCONTROL_HIGH] then > Result := NO_ERROR > else > Exit; > end; // case > > if Result = NO_ERROR then > begin > if ServiceThread.Suspended then ServiceThread.Resume; > PostThreadMessage(ServiceThread.ThreadID, Msg, WP, LP); > end; 774c1391,1408 < procedure TService.DoStart; --- > function TDDService.ConsoleCtrlHandler(Ctrl: DWord): LongBool; > begin > Result := False; > if FStatus in [csStopped, csStartPending] then Exit; > if (eoSynchronizeConsoleEvents in FExOptions) then > begin > if (FServiceWindow <> 0) then > begin > if ServiceThread.Suspended then ServiceThread.Resume; > Cardinal(Result) := SendMessage(FServiceWindow, > CM_SERVICE_CONSOLE_CTRL, Ctrl, 0); > end; > end > else > Result := DoConsoleEvent(Ctrl); > end; > > procedure TDDService.DoStart; 792c1426 < function TService.DoStop: Boolean; --- > function TDDService.DoStop: Boolean; 800c1434,1459 < function TService.DoPause: Boolean; --- > function TDDService.DoContinue: Boolean; > begin > Result := True; > Status := csContinuePending; > if Assigned(FOnContinue) then FOnContinue(Self, Result); > if Result then > Status := csRunning; > end; > > procedure TDDService.DoInterrogate; > begin > ReportStatus; > end; > > procedure TDDService.DoShutdown; > begin > Status := csStopPending; > try > if Assigned(FOnShutdown) then FOnShutdown(Self); > finally > { Shutdown cannot abort, it must stop regardless of any exception } > ServiceThread.Terminate; > end; > end; > > function TDDService.DoPause: Boolean; 808c1467,1468 < ServiceThread.Suspend; --- > if eoSuspendServiceThreadOnPause in FExOptions then > ServiceThread.Suspend; 812c1472,1502 < function TService.DoContinue: Boolean; --- > procedure TDDService.DoCustomControl(CtrlCode: DWord); > begin > if Assigned(FOnCustomControl) then > FOnCustomControl(Self, CtrlCode) > end; > > function TDDService.DoConsoleEvent(CtrlCode: Integer): Boolean; > var > EventProc: TConsoleEvent; > begin > Result := False; > EventProc := FOnConsoleEvent; > if Assigned(EventProc) then > EventProc(Self, CtrlCode, Result); > end; > (* I never received this control neither in W2K, XP nor in Vista > function TDDService.DoHardwareProfileChange(EventType: Integer): Integer; > begin > Result := 0; > if Assigned(FOnHardwareProfileChange) then > FOnHardwareProfileChange(Self, EventType, 0, Result); > end; > *) > function TDDService.DoDeviceEvent(EventType: Integer; EventData: TDDIntPtr): Integer; > begin > Result := 0; > if Assigned(FOnDeviceEvent) and (Status <> csStartPending) then > FOnDeviceEvent(Self, EventType, EventData, Result); > end; > > function TDDService.DoRunException(E: Exception; var CanAbort: Boolean): Boolean; 813a1504 > CanAbort := False; 815,818c1506,1507 < Status := csContinuePending; < if Assigned(FOnContinue) then FOnContinue(Self, Result); < if Result then < Status := csRunning; --- > if Assigned(FOnRunException) then > FOnRunException(Self, E, Result, CanAbort); 821c1510 < procedure TService.DoInterrogate; --- > procedure TDDService.DoParamChange; 823a1513,1521 > if Assigned(FOnParamChange) then > FOnParamChange(Self); > end; > > function TDDService.DoPowerEvent(EventType: Integer; EventData: TDDIntPtr): Integer; > begin > Result := 0; > if Assigned(FOnPowerEvent) and (Status <> csStartPending) then > FOnPowerEvent(Self, EventType, EventData, Result); 826c1524 < procedure TService.DoShutdown; --- > procedure TDDService.DoPreShutdown; 830c1528 < if Assigned(FOnShutdown) then FOnShutdown(Self); --- > if Assigned(FOnPreShutdown) then OnPreShutdown(Self); 832c1530 < { Shutdown cannot abort, it must stop regardless of any exception } --- > { PreShutdown cannot abort, it must stop regardless of any exception } 837c1535,1601 < function TService.DoCustomControl(CtrlCode: DWord): Boolean; --- > procedure TDDService.DoNetBindChange(EventType: Integer); > begin > ReportStatus; > if Assigned(FOnNetBindChange) then > FOnNetBindChange(Self, EventType); > end; > > procedure TDDService.DoSessionChange(EventType, SessionID: Integer); > begin > ReportStatus; > if Assigned(FOnSessionChange) then > FOnSessionChange(Self, EventType, SessionID); > end; > > procedure TDDService.SetDescription(const Value: String); > begin > if Length(Value) >= 1024 then > raise Exception.Create(SInvalidServiceDescription); > FDescription := Value; > end; > > procedure TDDService.SetFailureActions(Value: TFailureActions); > begin > FFailureActions.Assign(Value); > end; > > procedure TDDService.SetFailureOptions(Value: TFailureOptions); > begin > FFailureOptions.Assign(Value); > end; > > procedure TDDService.SetRequiredPrivileges(Value: TStrings); > begin > FRequiredPrivileges.Assign(Value); > end; > > procedure TDDService.SetOnNetBindChange(Value: TControlEvent); > begin > FOnNetBindChange := Value; > FAllowedExControls := FAllowedExControls + [alNetBindChange]; > end; > > procedure TDDService.SetExOptions(Value: TExOptions); > begin > FExOptions := Value; > if (eoForceServiceThreadWindow in FExOptions) or > (Assigned(FOnConsoleEvent) and (eoSynchronizeConsoleEvents in FExOptions)) then > CheckCreateServiceThreadWindow; > end; > > function TDDService.ThreadWindowNeeded: Boolean; > begin > Result := (eoForceServiceThreadWindow in FExOptions) or > Assigned(FOnPowerEvent) or Assigned(FOnDeviceEvent) or > (Assigned(FOnConsoleEvent) and (eoSynchronizeConsoleEvents in FExOptions)); > end; > > procedure TDDService.CheckCreateServiceThreadWindow; > begin > if Assigned(FServiceThread) and (FServiceWindow = 0) then > begin > FServiceWindow := AllocateHwnd; > if FServiceWindow = 0 then raise Exception.Create(SFailureCreateWindow); > end; > end; > > procedure TDDService.DestroyServiceThreadWindow; 838a1603,1619 > if (FServiceWindow <> 0) then > begin > DeallocateHWnd(FServiceWindow); > FServiceWindow := 0; > end; > end; > > function IsValidServiceName(const SvcName: string): Boolean; > var > I: Integer; > begin > Result := False; > if (Length(SvcName) = 0) or (Length(SvcName) > 256) then Exit; > for I := 1 to Length(SvcName) do > case SvcName[I] of > '\', '/' : Exit; > end; 845c1626 < TServiceClass = class of TService; --- > TDDServiceClass = class of TDDService; 847,848c1628,1629 < {$IF DEFINED(CLR)} < procedure ServiceMain(Argc: DWord; Argv: IntPtr); --- > {$IFDEF COMPILER16_UP} > procedure ServiceMain(Argc: DWord; Argv: PLPWSTR); stdcall; 851c1632 < {$IFEND} --- > {$ENDIF} 856,860d1636 < {$IF DEFINED(CLR)} < const < ServiceMainDelegate: TServiceMainFunction = @ServiceMain; < {$IFEND} < 862a1639,1641 > {$IFDEF COMPILER16_UP} > with Vcl.Forms.Application do > {$ELSE} 863a1643 > {$ENDIF} 883c1663 < Forms.Application.HookMainWindow(Hook); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HookMainWindow(Hook); 888,890c1668,1671 < FreeAndNil(FEventLogger); < Forms.Application.OnException := nil; < Forms.Application.UnhookMainWindow(Hook); --- > FEventLogger.Free; > FEventLogger := nil; > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.OnException := nil; > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.UnhookMainWindow(Hook); 894,910c1675,1676 < {$IF DEFINED(CLR)} < procedure TServiceApplication.DispatchServiceMain(Argc: DWord; Argv: IntPtr); < var < i: Integer; < PSTR: IntPtr; < begin < for i := 0 to ComponentCount - 1 do < if (Components[i] is TService) then < begin < PStr := Marshal.ReadIntPtr(Argv, 0); < if SameText(Marshal.PtrToStringAuto(PStr), Components[i].Name) then < begin < TService(Components[i]).Main(Argc, Argv); < break; < end; < end; < end; --- > {$IFDEF COMPILER16_UP} > procedure TServiceApplication.DispatchServiceMain(Argc: DWord; Argv: PLPWSTR); 912a1679 > {$ENDIF} 917,918c1684,1685 < if (Components[i] is TService) and < (AnsiCompareText(PChar(Argv^), Components[i].Name) = 0) then --- > if (Components[i] is TDDService) and > (AnsiCompareText(PChar(Argv^), TDDService(Components[i]).ServiceName) = 0) then 920c1687 < TService(Components[i]).Main(Argc, Argv); --- > TDDService(Components[i]).Main(Argc, Argv); 924d1690 < {$IFEND} 932c1698 < if Components[i] is TService then --- > if Components[i] is TDDService then 935a1702,1846 > function EnableShutdownPrivilege: Boolean; > var > hToken: THandle; > NewState: TTokenPrivileges; > OldState: PTokenPrivileges; > RetLen: DWord; > Luid: TLargeInteger; > begin > Result := False; > if OpenProcessToken(GetCurrentProcess, > TOKEN_ADJUST_PRIVILEGES, hToken) then > try > if not LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME , Luid) then > Exit; > NewState.PrivilegeCount := 1; > NewState.Privileges[0].Luid := Luid; > NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; > OldState := nil; > RetLen := 0; > if AdjustTokenPrivileges(hToken, False, NewState, SizeOf(TTokenPrivileges), > OldState, RetLen) then > Result := True; > finally > CloseHandle(hToken); > end; > end; > > procedure TServiceApplication.ChangeServiceConfiguration2(Service: TDDService; > hService: THandle); > var > ADescription: TServiceDescription; > AFailureActions: TServiceFailureActions; > AFailureActionsFlag: TServiceFailureActionsFlag; > APreShutdownInfo: TServicePreShutDownInfo; > ADelayedAutoStartInfo: TServiceDelayedAutoStartInfo; > ASidInfo: TServiceSidInfo; > ARequiredPrivilegesInfo: TServiceRequiredPrivilegesInfo; > PActions: PScAction; > Action: TFailureAction; > I: Integer; > ShutdownFlag: Boolean; > begin > with Service do > begin > // Win 2000 > if IsWin2K then > begin > ADescription.lpDescription := PChar(FDescription); > if not ChangeServiceConfig2(hService, SERVICE_CONFIG_DESCRIPTION, > @ADescription) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), SDescription]); > > if FailureOptions.FResetPeriod < 0 then > AFailureActions.dwResetPeriod := INFINITE > else > AFailureActions.dwResetPeriod := FailureOptions.ResetPeriod; > > AFailureActions.lpRebootMsg := PChar(FailureOptions.FRebootMessage); > AFailureActions.lpCommand := PChar(FailureOptions.FCommand); > AFailureActions.cActions := FailureActions.Count; > > I := SizeOf(TScAction) * FailureActions.Count; > GetMem(PActions, I); > try > ZeroMemory(PActions, I); > AFailureActions.lpsaActions := PActions; > ShutdownFlag := False; > for I := 0 to FailureActions.Count -1 do > begin > Action := FailureActions[I]; > PActions^.Type_ := ActionTypes[Action.ActionType]; > PActions^.Delay := Action.Delay; > Inc(PActions); > ShutdownFlag := ShutdownFlag or (Action.ActionType = faReboot); > end; > { SE_SHUTDOWN_NAME is required and must be enabled ! } > if ShutdownFlag then > if not EnableShutdownPrivilege then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SRecoveryOptions]); > if not ChangeServiceConfig2(hService, SERVICE_CONFIG_FAILURE_ACTIONS, > @AFailureActions) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SRecoveryOptions]); > finally > FreeMem(AFailureActions.lpsaActions); > end; > > // Win Vista > if IsWinVista then > begin > // LongBool must be either 0 or 1! > Cardinal(AFailureActionsFlag.fFailureActionsOnNonCrashFailures) := > Ord(FailureOptions.FNonCrashFailures); > if not ChangeServiceConfig2(hService, SERVICE_CONFIG_FAILURE_ACTIONS_FLAG, > @AFailureActionsFlag) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SNonCrashFailures]); > APreShutdownInfo.dwPreshutdownTimeout := FPreShutdownTimeout; > if not ChangeServiceConfig2(hService, SERVICE_CONFIG_PRESHUTDOWN_INFO, > @APreShutdownInfo) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SPreshutdownTimeout]); > // LongBool must be either 0 or 1! > Cardinal(ADelayedAutoStartInfo.fDelayedAutostart) := > Ord(FStartType = stAutoDelayed); > if not ChangeServiceConfig2(hService, > SERVICE_CONFIG_DELAYED_AUTO_START_INFO, > @ADelayedAutoStartInfo) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SDelayedAutoStart]); > case ServiceSidType of > stUnrestricted: ASidInfo.dwServiceSidType := > SERVICE_SID_TYPE_UNRESTRICTED; > stRestricted: ASidInfo.dwServiceSidType := > SERVICE_SID_TYPE_RESTRICTED; > else > ASidInfo.dwServiceSidType := SERVICE_SID_TYPE_NONE; > end; > if not ChangeServiceConfig2(hService, SERVICE_CONFIG_SERVICE_SID_INFO, > @ASidInfo) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SServiceSidType]); > > ARequiredPrivilegesInfo.pmszRequiredPrivileges := > PChar(StrToMultiSZ(FRequiredPrivileges)); > if not ChangeServiceConfig2(hService, > SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO, > @ARequiredPrivilegesInfo) then > raise Exception.CreateFmt(SServiceConfigError, > [SysErrorMessage(GetLastError), > SRequiredPrivileges]); > > end; // Vista > end; // Win2000 > end; > end; > 938c1849 < procedure InstallService(Service: TService; SvcMgr: Integer); --- > procedure InstallService(Service: TDDService; SvcMgr: SC_HANDLE); 940d1850 < {$IF DEFINED(CLR)} 942,947c1852,1854 < Svc: Integer; < {$ELSE} < TmpTagID, Svc: Integer; < PTag, PSSN: Pointer; < {$IFEND} < Path: string; --- > PTag: PDWORD; > PSSN: PChar; > Svc: SC_HANDLE; 949d1855 < Path := ParamStr(0); 952,971c1858,1860 < if Assigned(BeforeInstall) then BeforeInstall(Service); < TmpTagID := TagID; < {$IF DEFINED(CLR)} < if (TagID <> 0) and (ServiceStartName <> '') then < Svc := CreateService(SvcMgr, Name, DisplayName, SERVICE_ALL_ACCESS, < GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < Path, LoadGroup, TmpTagID, GetNTDependencies, ServiceStartName, Password) < else if TagID <> 0 then < Svc := CreateService(SvcMgr, Name, DisplayName, SERVICE_ALL_ACCESS, < GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < Path, LoadGroup, TmpTagID, GetNTDependencies, nil, Password) < else if ServiceStartName <> '' then < Svc := CreateService(SvcMgr, Name, DisplayName, SERVICE_ALL_ACCESS, < GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < Path, LoadGroup, nil, GetNTDependencies, ServiceStartName, Password) < else < Svc := CreateService(SvcMgr, Name, DisplayName, SERVICE_ALL_ACCESS, < GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < Path, LoadGroup, nil, GetNTDependencies, nil, Password); < {$ELSE} --- > if Assigned(BeforeInstall) then BeforeInstall(Service); > > TmpTagID := TagID; 972a1862 > 974c1864,1865 < PSSN := nil else --- > PSSN := nil > else 976,980c1867,1881 < Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName), < SERVICE_ALL_ACCESS, GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies), < PSSN, PChar(Password)); < {$IFEND} --- > > Svc := CreateService(SvcMgr, > PChar(ServiceName), > PChar(DisplayName), > SERVICE_ALL_ACCESS, > GetNTServiceType, > GetNTStartType, > GetNTErrorSeverity, > PChar(ImagePath), > PChar(LoadGroup), > PTag, > PChar(GetNTDependencies), > PSSN, > PChar(Password)); > 981a1883 > 985a1888 > ChangeServiceConfiguration2(Service, Svc); 1000c1903 < procedure UninstallService(Service: TService; SvcMgr: Integer); --- > procedure UninstallService(Service: TDDService; SvcMgr: SC_HANDLE); 1002c1905 < Svc: Integer; --- > Svc: SC_HANDLE; 1007,1011c1910 < {$IF DEFINED(CLR)} < Svc := OpenService(SvcMgr, Name, SERVICE_ALL_ACCESS); < {$ELSE} < Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS); < {$IFEND} --- > Svc := OpenService(SvcMgr, PChar(ServiceName), SERVICE_ALL_ACCESS); 1021a1921,1927 > procedure DisplayMessage(const Msg: string; const MsgType: TMsgDlgType); > begin > if IsConsole then > WriteLn(Msg) > else > MessageDlg(Msg, MsgType, [mbOk], 0); > end; 1024c1930 < SvcMgr: Integer; --- > SvcMgr: SC_HANDLE; 1030,1032d1935 < {$IF DEFINED(CLR)} < SvcMgr := OpenSCManager('', nil, SC_MANAGER_ALL_ACCESS); < {$ELSE} 1034d1936 < {$IFEND} 1038c1940 < if Components[i] is TService then --- > if Components[i] is TDDService then 1041,1042c1943,1945 < InstallService(TService(Components[i]), SvcMgr) else < UninstallService(TService(Components[i]), SvcMgr) --- > InstallService(TDDService(Components[i]), SvcMgr) > else > UninstallService(TDDService(Components[i]), SvcMgr); 1048c1951,1952 < Msg := SServiceInstallFailed else --- > Msg := SServiceInstallFailed > else 1050,1051c1954,1955 < with TService(Components[i]) do < MessageDlg(Format(Msg, [DisplayName, E.Message]), mtError, [mbOK],0); --- > with TDDService(Components[i]) do > DisplayMessage(Format(Msg, [DisplayName, E.Message]), mtError); 1056,1057c1960,1962 < MessageDlg(SServiceInstallOK, mtInformation, [mbOk], 0) else < MessageDlg(SServiceUninstallOK, mtInformation, [mbOk], 0); --- > DisplayMessage(SServiceInstallOK, mtInformation) > else > DisplayMessage(SServiceUninstallOK, mtInformation); 1071c1976 < if InstanceClass.InheritsFrom(TService) then --- > if InstanceClass.InheritsFrom(TDDService) then 1073,1080d1977 < {$IF DEFINED(CLR)} < try < Reference := TServiceClass(InstanceClass).Create(Self); < except < Reference := nil; < raise; < end; < {$ELSE} 1087d1983 < {$IFEND} 1089c1985 < Forms.Application.CreateForm(InstanceClass, Reference); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.CreateForm(InstanceClass, Reference); 1102,1103c1998,1999 < Forms.Application.ShowMainForm :=False; < Forms.Application.Initialize; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.ShowMainForm := False; > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Initialize; 1117a2014,2015 > var > Handled : Boolean; 1119c2017,2021 < DoHandleException(E); --- > Handled := FALSE; > if Assigned(FOnException) then > FOnException(Sender, E, Handled); > if not Handled then > DoHandleException(E); 1131,1133d2032 < {$IF DEFINED(CLR)} < property ReturnValue; < {$IFEND} 1140,1146d2038 < {$IF DEFINED(CLR)} < inherited Create(True); < FreeOnTerminate := False; < ReturnValue := 0; < FServiceStartTable := Services; < Resume; < {$ELSE} 1151d2042 < {$IFEND} 1157c2048 < PostMessage(Forms.Application.Handle, WM_QUIT, 0, 0); --- > PostMessage({$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Handle, WM_QUIT, 0, 0); 1174d2064 < {$IF NOT DEFINED(CLR)} 1176d2065 < {$IFEND} 1183c2072 < Forms.Application.OnException := OnExceptionHandler; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.OnException := OnExceptionHandler; 1186c2075 < if Components[i] is TService then Inc(ServiceCount); --- > if Components[i] is TDDService then Inc(ServiceCount); 1188d2076 < {$IF NOT DEFINED(CLR)} 1190d2077 < {$IFEND} 1193c2080 < if Components[i] is TService then --- > if Components[i] is TDDService then 1195,1199c2082 < {$IF DEFINED(CLR)} < ServiceStartTable[J].lpServiceName := Components[i].Name; < ServiceStartTable[J].lpServiceProc := ServiceMainDelegate; < {$ELSE} < ServiceStartTable[J].lpServiceName := PChar(Components[i].Name); --- > ServiceStartTable[J].lpServiceName := PChar(TDDService(Components[i]).ServiceName); 1201d2083 < {$IFEND} 1206c2088 < while not Forms.Application.Terminated do --- > while not {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminated do 1208c2090 < Forms.Application.HandleMessage; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HandleMessage; 1213,1216c2095 < Forms.Application.Terminate; < {$IF DEFINED(CLR)} < DoneServiceApplication; < {$IFEND} --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminate; 1235a2115,2195 > { TFailureAction } > > procedure TFailureAction.Assign(Source: TPersistent); > begin > if Source is TFailureAction then > begin > Delay := TFailureAction(Source).Delay; > ActionType := TFailureAction(Source).ActionType; > end else > inherited Assign(Source); > end; > > function TFailureAction.GetDisplayName: String; > begin > case FActionType of > faReboot : Result := Format(SFailureReboot, [FDelay]); > faRestart : Result := Format(SFailureRestart, [FDelay]); > faRunCommand : result := Format(SFailureExecute, [FDelay]); > else > Result := SFailureNoAction; > end; > end; > > procedure TFailureAction.SetActionType(Value: TFailureActionType); > begin > FActionType := Value; > if FActionType = faNone then > FDelay := 0; > end; > > procedure TFailureAction.SetDelay(Value: Integer); > begin > if Value < 0 then > FDelay := 0 > else > FDelay := Value; > end; > > { TFailureActions } > > function TFailureActions.Add: TFailureAction; > begin > Result := TFailureAction.Create(Self); > end; > > constructor TFailureActions.Create(AOwner: TPersistent); > begin > inherited Create(TFailureAction); > FOwner := AOwner; > end; > > function TFailureActions.GetItems(Index: Integer): TFailureAction; > begin > Result := inherited Items[Index] as TFailureAction; > end; > > function TFailureActions.GetOwner: TPersistent; > begin > Result := FOwner; > end; > > { TFailureOptions } > > procedure TFailureOptions.Assign(Source: TPersistent); > begin > if Source is TFailureOptions then > begin > FResetPeriod := TFailureOptions(Source).FResetPeriod; > FRebootMessage := TFailureOptions(Source).FRebootMessage; > FCommand := TFailureOptions(Source).FCommand; > FNonCrashFailures := TFailureOptions(Source).FNonCrashFailures; > end else > inherited; > end; > > constructor TFailureOptions.Create; > begin > inherited; > FResetPeriod := -1; > end; > 1236a2197 > InitializeCriticalSection(CritSectWndClass); 1237a2199 > 1238a2201 > DeleteCriticalSection(CritSectWndClass);