0a1 > 8a10,72 > { } > { 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} 10c74 < unit Vcl.SvcMgr; --- > {$DEFINE COMPATIBILITY} 15a80,92 > {$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} 17,18c94,96 < {$IF DEFINED(CLR)} < System.Security.Permissions, System.ComponentModel.Design.Serialization, --- > Windows, Messages, WinSvc, SysUtils, Classes, > {$IFNDEF COMPILER6_UP} > Forms, 20c98,104 < Winapi.Windows, Winapi.Messages, Winapi.WinSvc, System.SysUtils, System.Classes; --- > DDWindows, DDWinSvc, DDSvcConsts; > {$ENDIF} > > const > CUSTOMCONTROL_LOW = 128; > CUSTOMCONTROL_HIGH = 255; > DEFAULT_PRESHUTDOWN_TIMEOUT = 180000; 25a110,114 > {$IFNDEF COMPATIBILITY} > TEventLogType = (etError, etWarning, etInformation, etAuditSuccess, > etAuditFailure); > {$ENDIF} > 30,33d118 < {$IF DEFINED(CLR)} < strict protected < procedure Finalize; override; < {$ENDIF} 37c122,127 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType = etError; > {$ELSE} > EventType: DWord = EVENTLOG_ERROR_TYPE; > {$ENDIF} 72c162,165 < 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 76c169 < TService = class; --- > TDDService = class; 78,80d170 < {$IF DEFINED(CLR)} < TServiceThread = class(TWin32Thread) < {$ELSE} 82d171 < {$ENDIF} 84c173 < FService: TService; --- > FService: TDDService; 87,89c176 < {$IF DEFINED(CLR)} < property Terminated; < {$ENDIF} --- > 91c178 < constructor Create(Service: TService); --- > constructor Create(Service: TDDService); 95c182 < { TService } --- > { TFailureAction } 97c184 < TServiceController = THandlerFunction; --- > TFailureActionType = (faNone, faRestart, faReboot, faRunCommand); 99c186,199 < 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; 101,102c201 < TCurrentStatus = (csStopped, csStartPending, csStopPending, csRunning, < csContinuePending, csPausePending, csPaused); --- > { TFailureActions } 104c203,231 < 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; > > { TFailureOptions } > > 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; 106c233 < TStartType = (stBoot, stSystem, stAuto, stManual, stDisabled); --- > { TDDService } 108,112c235,265 < 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; --- > {$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; 114,115c267 < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] < TService = class(TDataModule) --- > TDDService = class(TDataModule) 116a269 > FServiceStatus: TServiceStatus; 118a272,274 > FAllowedExControls: TAllowedExControls; > FConsoleHandler: Pointer; > FPreShutdownTimeout: Integer; 119a276 > FDescription: String; 120a278 > FServiceName: String; 123a282,283 > FFailureActions: TFailureActions; > FFailureOptions: TFailureOptions; 124a285 > FImagePath: String; 127a289 > FRequiredPrivileges: TStrings; 129a292 > FExOptions: TExOptions; 130a294 > FServiceSidType: TServiceSidType; 134a299 > FServiceWindow: Hwnd; 140a306 > FTriggerStarted: Boolean; 141a308 > FOnDeviceEvent: TMessageEvent; 142a310,311 > //FOnHardwareProfileChange: TMessageEvent; > FOnNetBindChange: TControlEvent; 143a313 > FOnPowerEvent: TMessageEvent; 144a315,316 > FOnPreShutdown: TServiceEvent; > FOnParamChange: TServiceEvent; 146a319,322 > FOnSessionChange: TSessionChangeEvent; > FOnCustomControl: TCustomControlEvent; > FOnConsoleEvent: TConsoleEvent; > FOnRunException: TServiceExceptionEvent; 147a324,325 > function GetServiceName: String; > procedure SetServiceName(const Value: String); 156c334 < function GetNTControlsAccepted: Integer; --- > function GetNTControlsAccepted: DWORD; 159a338 > procedure SetOnConsoleEvent(Value: TConsoleEvent); 161a341,343 > function AreFailureActionsStored: Boolean; > procedure SetFailureOptions(Value: TFailureOptions); > procedure SetFailureActions(Value: TFailureActions); 164a347,359 > 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); 165a361,365 > {$IFDEF COMPILER16_UP} > procedure Main(Argc: DWord; Argv: PLPWSTR); > {$ELSE} > procedure Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 166a367,368 > function ControllerEx(CtrlCode, EventType: DWord; EventData, Context: Pointer): DWord; > function ConsoleCtrlHandler(Ctrl: DWord): LongBool; 168,170c370,372 < function DoStop: Boolean; virtual; < function DoPause: Boolean; virtual; < function DoContinue: Boolean; virtual; --- > function DoStop: Boolean; virtual; > function DoPause: Boolean; virtual; > function DoContinue: Boolean; virtual; 173,178c375,386 < function DoCustomControl(CtrlCode: DWord): Boolean; virtual; < {$IF DEFINED(CLR)} < procedure Main(Argc: DWord; Argv: IntPtr); < {$ELSE} < procedure Main(Argc: DWord; Argv: PLPWSTR); < {$ENDIF} --- > 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; 179a388 > constructor Create(AOwner: TComponent); override; 182a392,393 > function GetServiceControllerEx: TServiceControllerEx; virtual; abstract; > function GetConsoleCtrlHandler: TServiceConsoleCtrlHandler; virtual; abstract; 184c395 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; {$IFNDEF COMPATIBILITY}EventType: TEventLogType = etError;{$ELSE}EventType: DWord = 1;{$ENDIF} 185a397 > procedure Stop; 186a399 > property ImagePath: String read FImagePath write FImagePath; 191a405,406 > property TriggerStarted: Boolean read FTriggerStarted; > property ServiceWindow: HWND read FServiceWindow; 195a411 > property AllowedExControls: TAllowedExControls read FAllowedExControls write FAllowedExControls default []; 197c413,415 < 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; 198a417,419 > 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; 201a423,424 > property PreShutdownTimeout: Integer read FPreShutdownTimeout write FPreShutdownTimeout default DEFAULT_PRESHUTDOWN_TIMEOUT; > property RequiredPrivileges: TStrings read FRequiredPrivileges write SetRequiredPrivileges; 204a428 > property ServiceSidType: TServiceSidType read FServiceSidType write FServiceSidType default stNone; 211a436 > property OnDeviceEvent: TMessageEvent read FOnDeviceEvent write SetOnDeviceEvent; 212a438,439 > property OnNetBindChange: TControlEvent read FOnNetBindChange write SetOnNetBindChange; > property OnParamChange: TServiceEvent read FOnParamChange write SetOnParamChange; 213a441,442 > property OnPowerEvent: TMessageEvent read FOnPowerEvent write SetOnPowerEvent; > property OnRunException: TServiceExceptionEvent read FOnRunException write FOnRunException; 216a446,449 > 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; 221,222c454,455 < [RootDesignerSerializerAttribute('', '', False)] < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] --- > TExceptionEvent = procedure(Sender: TObject; E: Exception; var Handled: Boolean) of object; > 228a462 > FOnException: TExceptionEvent; 234,237c468 < function Hook(var Message: TMessage): Boolean; < {$IF DEFINED(CLR)} < procedure DispatchServiceMain(Argc: DWord; Argv: IntPtr); < {$ELSE} --- > {$IFDEF COMPILER16_UP} 239c470,474 < {$ENDIF} --- > {$ELSE} > procedure DispatchServiceMain(Argc: DWord; Argv: PLPSTR); > {$ENDIF} > function Hook(var Message: TMessage): Boolean; > procedure ChangeServiceConfiguration2(Service: TDDService; hService: THandle); {virtual;} 244a480 > property EventLogger: TEventLogger read FEventLogger; 250a487 > property OnException: TExceptionEvent read FOnException write FOnException; 252a490,491 > function IsValidServiceName(const SvcName: string): Boolean; > 257a497,503 > {$IFDEF COMPILER16_UP} > uses > {$IFDEF COMPILER6_UP} > Vcl.Forms, > {$ENDIF} > Vcl.Dialogs, Vcl.Consts; > {$ELSE} 259,260c505,603 < {$IF DEFINED(CLR)} < System.Runtime.InteropServices, System.IO, --- > {$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; 262d604 < System.UITypes, Vcl.Forms, Vcl.Dialogs, Vcl.Consts; 273,281d614 < {$IF DEFINED(CLR)} < procedure TEventLogger.Finalize; < begin < if FEventLog <> 0 then < DeregisterEventSource(FEventLog); < inherited; < end; < {$ENDIF} < 289,291d621 < {$IF DEFINED(CLR)} < System.GC.SuppressFinalize(self); < {$ENDIF} 295,315c625,627 < 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; 316a629,631 > EventType: DWord; > {$ENDIF} > Category: Word; ID: DWord); 318c633 < P: Pointer; --- > PMsg: Pointer; 320c635 < P := PChar(Message); --- > PMsg := PChar(Msg); 323,324c638,642 < ReportEvent(FEventLog, EventType, Category, ID, nil, 1, 0, @P, nil); < end; --- > {$IFNDEF COMPATIBILITY} > ReportEvent(FEventLog, EventLogTypes[EventType], > Category, ID, nil, 1, 0, @PMsg, nil); > {$ELSE} > ReportEvent(FEventLog, EventType, Category, ID, nil, 1, 0, @PMsg, nil); 325a644 > end; 361c680,684 < constructor TServiceThread.Create(Service: TService); --- > function ThreadWindowProc(aWnd: HWND; aMsg: UINT; aWParam: WPARAM; > aLParam: LPARAM): LRESULT; stdcall; > var > Obj: TObject; > MsgRec: TMessage; 363,365c686,687 < {$IF DEFINED(CLR)} < inherited Create(True); < FService := Service; --- > {$IFDEF WIN64} > Obj := TObject(GetWindowLongPtr(aWnd, 0)); 366a689,769 > 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 369d771 < {$ENDIF} 386,387c788,789 < if Assigned(FService.OnStart) then FService.OnStart(FService, Started); < if not Started then Exit; --- > if FService.ThreadWindowNeeded then > FService.CheckCreateServiceThreadWindow; 389,397c791,810 < 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; 406,407c819,822 < 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); 411c826 < msg: TMsg; --- > msg: tagMSG; 414a830 > CanAbort: Boolean; 423a840 > 431c848 < case NativeInt(msg.wParam) of --- > case msg.wParam of 436a854,859 > 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; 438c861,862 < ActionOK := FService.DoCustomControl(msg.wParam); --- > {user-defined control code = Range 128 to 255 } > FService.DoCustomControl(msg.wParam); 447,451c871,895 < if NativeInt(msg.wParam) in [1..5] then < ErrorMsg := Format(SServiceFailed, [ActionStr[NativeInt(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; > end; > end; > 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; 454c898,900 < end else --- > end > else begin > TranslateMessage(msg); 456c902,905 < end else --- > end; > end > else begin > TranslateMessage(msg); 457a907,935 > end; > end; > end; > > 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; 461c939,946 < { TService } --- > { 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; 463c948 < constructor TService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); --- > constructor TDDService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); 475a961,968 > 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]; 478c971 < destructor TService.Destroy; --- > destructor TDDService.Destroy; 482a976,978 > FFailureOptions.Free; > FFailureActions.Free; > FRequiredPrivileges.Free; 486c982 < function TService.GetDisplayName: String; --- > function TDDService.GetDisplayName: String; 494c990,1005 < 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); 505c1016 < procedure TService.SetPassword(const Value: string); --- > procedure TDDService.SetPassword(const Value: String); 513c1024 < procedure TService.SetServiceStartName(const Value: string); --- > procedure TDDService.SetServiceStartName(const Value: String); 521c1032 < procedure TService.SetDependencies(Value: TDependencies); --- > procedure TDDService.SetDependencies(Value: TDependencies); 526c1037 < function TService.AreDependenciesStored: Boolean; --- > function TDDService.AreDependenciesStored: Boolean; 531c1042,1047 < function TService.GetParamCount: Integer; --- > function TDDService.AreFailureActionsStored: Boolean; > begin > Result := FFailureActions.Count > 0; > end; > > function TDDService.GetParamCount: Integer; 536c1052 < function TService.GetParam(Index: Integer): String; --- > function TDDService.GetParam(Index: Integer): String; 541c1057 < procedure TService.SetOnContinue(Value: TContinueEvent); --- > procedure TDDService.SetOnContinue(Value: TContinueEvent); 547c1063 < procedure TService.SetOnPause(Value: TPauseEvent); --- > procedure TDDService.SetOnPause(Value: TPauseEvent); 553c1069 < procedure TService.SetOnStop(Value: TStopEvent); --- > procedure TDDService.SetOnStop(Value: TStopEvent); 559c1075,1129 < 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; 566c1136 < function TService.GetNTDependencies: String; --- > function TDDService.GetNTDependencies: String; 568,573c1138 < {$IF DEFINED(CLR)} < I, J, Len: Integer; < Pos: Integer; < Temp: string; < {$ELSE} < I, Len: Integer; --- > i, Len: Integer; 575d1139 < {$ENDIF} 584,608d1147 < {$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} 626d1164 < {$ENDIF} 633c1171 < function TService.GetNTServiceType: DWORD; --- > function TDDService.GetNTServiceType: DWORD; 645c1183 < SERVICE_DISABLED); --- > SERVICE_DISABLED, SERVICE_AUTO_START); 647c1185 < function TService.GetNTStartType: DWORD; --- > function TDDService.GetNTStartType: DWORD; 654c1192 < function TService.GetNTErrorSeverity: DWORD; --- > function TDDService.GetNTErrorSeverity: DWORD; 662c1200 < function TService.GetNTControlsAccepted: Integer; --- > function TDDService.GetNTControlsAccepted: DWORD; 667d1204 < end; 669,670c1206,1232 < procedure TService.LogMessage(Message: String; EventType: DWord; Category, ID: Integer); < begin --- > 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; > end; > > procedure TDDService.LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType; > {$ELSE} > EventType: DWord; > {$ENDIF} > Category, ID: Integer); > begin 672,673c1234,1235 < FEventLogger := TEventLogger.Create(Name); < FEventLogger.LogMessage(Message, EventType, Category, ID); --- > FEventLogger := TEventLogger.Create(ServiceName); > FEventLogger.LogMessage(Msg, EventType, Category, ID); 679,680c1241,1242 < SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING, < SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED); --- > SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING, > SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED); 682c1244 < csContinuePending, csPausePending]; --- > csContinuePending, csPausePending]; 684,686c1246,1248 < procedure TService.ReportStatus; < var < ServiceStatus: TServiceStatus; --- > procedure TDDService.ReportStatus; > {var > ServiceStatus: TServiceStatus; } 688c1250 < with ServiceStatus do --- > with FServiceStatus do 693c1255,1256 < dwControlsAccepted := 0 else --- > dwControlsAccepted := 0 > else 694a1258 > 696c1260,1261 < Inc(dwCheckPoint) else --- > Inc(dwCheckPoint) > else 704,705c1269,1270 < if not SetServiceStatus(FStatusHandle, ServiceStatus) then < LogMessage(SysErrorMessage(GetLastError)); --- > if not SetServiceStatus(FStatusHandle, FServiceStatus) then > LogMessage('ReportStatus: ' + SysErrorMessage(GetLastError)); 709c1274 < procedure TService.SetStatus(Value: TCurrentStatus); --- > procedure TDDService.SetStatus(Value: TCurrentStatus); 716,721c1281 < {$IF DEFINED(CLR)} < procedure TService.Main(Argc: DWord; Argv: IntPtr); < var < i: Integer; < Controller: TServiceController; < PStr: IntPtr; --- > procedure TDDService.Stop; 723c1283 < for i := 0 to Argc - 1 do --- > if Assigned(ServiceThread) then 725,726c1285,1287 < 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); 728,733d1288 < Controller := Self.GetServiceController(); < FStatusHandle := RegisterServiceCtrlHandler(Name, Controller); < if (FStatusHandle = 0) then < LogMessage(SysErrorMessage(GetLastError)) < else < DoStart; 734a1290,1292 > > {$IFDEF COMPILER16_UP} > procedure TDDService.Main(Argc: DWord; Argv: PLPWSTR); 736c1294,1295 < procedure TService.Main(Argc: DWord; Argv: PLPWSTR); --- > procedure TDDService.Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 742c1301 < Controller: THandlerFunction; --- > Controller: Pointer; 746,747c1305,1315 < 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; 753d1320 < {$ENDIF} 755c1322 < procedure TService.Controller(CtrlCode: DWord); --- > procedure TDDService.Controller(CtrlCode: DWord); 757d1323 < PostThreadMessage(ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, CtrlCode, 0); 758a1325,1389 > 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; 761c1392,1409 < 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; 779c1427 < function TService.DoStop: Boolean; --- > function TDDService.DoStop: Boolean; 787c1435,1460 < 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; 795c1468,1469 < ServiceThread.Suspend; --- > if eoSuspendServiceThreadOnPause in FExOptions then > ServiceThread.Suspend; 799c1473 < function TService.DoContinue: Boolean; --- > procedure TDDService.DoCustomControl(CtrlCode: DWord); 800a1475,1505 > 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; > begin > CanAbort := False; 802,805c1507,1508 < Status := csContinuePending; < if Assigned(FOnContinue) then FOnContinue(Self, Result); < if Result then < Status := csRunning; --- > if Assigned(FOnRunException) then > FOnRunException(Self, E, Result, CanAbort); 808c1511 < procedure TService.DoInterrogate; --- > procedure TDDService.DoParamChange; 810a1514,1522 > 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); 813c1525 < procedure TService.DoShutdown; --- > procedure TDDService.DoPreShutdown; 817c1529 < if Assigned(FOnShutdown) then FOnShutdown(Self); --- > if Assigned(FOnPreShutdown) then OnPreShutdown(Self); 819c1531 < { Shutdown cannot abort, it must stop regardless of any exception } --- > { PreShutdown cannot abort, it must stop regardless of any exception } 824c1536,1613 < 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; > begin > if (FServiceWindow <> 0) then > begin > DeallocateHWnd(FServiceWindow); > FServiceWindow := 0; > end; > end; > > function IsValidServiceName(const SvcName: string): Boolean; > var > I: Integer; 825a1615,1620 > 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; 832c1627 < TServiceClass = class of TService; --- > TDDServiceClass = class of TDDService; 834,836c1629 < {$IF DEFINED(CLR)} < procedure ServiceMain(Argc: DWord; Argv: IntPtr); < {$ELSE} --- > {$IFDEF COMPILER16_UP} 837a1631,1632 > {$ELSE} > procedure ServiceMain(Argc: DWord; Argv: PLPSTR); stdcall; 843,847d1637 < {$IF DEFINED(CLR)} < const < ServiceMainDelegate: TServiceMainFunction = @ServiceMain; < {$ENDIF} < 849a1640 > {$IFDEF COMPILER16_UP} 850a1642,1644 > {$ELSE} > with Forms.Application do > {$ENDIF} 870c1664 < Vcl.Forms.Application.HookMainWindow(Hook); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HookMainWindow(Hook); 875,877c1669,1672 < FreeAndNil(FEventLogger); < Vcl.Forms.Application.OnException := nil; < Vcl.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); 881,898c1676 < {$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; < {$ELSE} --- > {$IFDEF COMPILER16_UP} 899a1678,1680 > {$ELSE} > procedure TServiceApplication.DispatchServiceMain(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 904,905c1685,1686 < if (Components[i] is TService) and < (AnsiCompareText(Argv^, Components[i].Name) = 0) then --- > if (Components[i] is TDDService) and > (AnsiCompareText(PChar(Argv^), TDDService(Components[i]).ServiceName) = 0) then 907c1688 < TService(Components[i]).Main(Argc, Argv); --- > TDDService(Components[i]).Main(Argc, Argv); 911d1691 < {$ENDIF} 919c1699 < if Components[i] is TService then --- > if Components[i] is TDDService then 922a1703,1847 > 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; > 925c1850 < procedure InstallService(Service: TService; SvcMgr: SC_HANDLE); --- > procedure InstallService(Service: TDDService; SvcMgr: SC_HANDLE); 927,929d1851 < {$IF DEFINED(CLR)} < TmpTagID: DWORD; < {$ELSE} 933d1854 < {$ENDIF} 935d1855 < Path: string; 937,939d1856 < Path := ParamStr(0); < if Pos(' ', Path) > 0 then < Path := '"' + Path + '"'; 942,961c1859,1861 < 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; 962a1863 > 964c1865,1866 < PSSN := nil else --- > PSSN := nil > else 966,970c1868,1882 < Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName), < SERVICE_ALL_ACCESS, GetNTServiceType, GetNTStartType, GetNTErrorSeverity, < PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies), < PSSN, PChar(Password)); < {$ENDIF} --- > > Svc := CreateService(SvcMgr, > PChar(ServiceName), > PChar(DisplayName), > SERVICE_ALL_ACCESS, > GetNTServiceType, > GetNTStartType, > GetNTErrorSeverity, > PChar(ImagePath), > PChar(LoadGroup), > PTag, > PChar(GetNTDependencies), > PSSN, > PChar(Password)); > 971a1884 > 975a1889 > ChangeServiceConfiguration2(Service, Svc); 990c1904 < procedure UninstallService(Service: TService; SvcMgr: SC_HANDLE); --- > procedure UninstallService(Service: TDDService; SvcMgr: SC_HANDLE); 997,1001c1911 < {$IF DEFINED(CLR)} < Svc := OpenService(SvcMgr, Name, SERVICE_ALL_ACCESS); < {$ELSE} < Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS); < {$ENDIF} --- > Svc := OpenService(SvcMgr, PChar(ServiceName), SERVICE_ALL_ACCESS); 1027,1029d1936 < {$IF DEFINED(CLR)} < SvcMgr := OpenSCManager('', nil, SC_MANAGER_ALL_ACCESS); < {$ELSE} 1031d1937 < {$ENDIF} 1035c1941 < if Components[i] is TService then --- > if Components[i] is TDDService then 1038c1944 < InstallService(TService(Components[i]), SvcMgr) --- > InstallService(TDDService(Components[i]), SvcMgr) 1040c1946 < UninstallService(TService(Components[i]), SvcMgr) --- > UninstallService(TDDService(Components[i]), SvcMgr); 1049c1955 < with TService(Components[i]) do --- > with TDDService(Components[i]) do 1071c1977 < if InstanceClass.InheritsFrom(TService) then --- > if InstanceClass.InheritsFrom(TDDService) then 1073,1080d1978 < {$IF DEFINED(CLR)} < try < Reference := TServiceClass(InstanceClass).Create(Self); < except < Reference := nil; < raise; < end; < {$ELSE} 1087d1984 < {$ENDIF} 1089c1986 < Vcl.Forms.Application.CreateForm(InstanceClass, Reference); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.CreateForm(InstanceClass, Reference); 1102,1103c1999,2000 < Vcl.Forms.Application.ShowMainForm :=False; < Vcl.Forms.Application.Initialize; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.ShowMainForm := False; > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Initialize; 1117a2015,2016 > var > Handled : Boolean; 1119c2018,2022 < DoHandleException(E); --- > Handled := FALSE; > if Assigned(FOnException) then > FOnException(Sender, E, Handled); > if not Handled then > DoHandleException(E); 1131,1133d2033 < {$IF DEFINED(CLR)} < property ReturnValue; < {$ENDIF} 1140,1146d2039 < {$IF DEFINED(CLR)} < inherited Create(True); < FreeOnTerminate := False; < ReturnValue := 0; < FServiceStartTable := Services; < Resume; < {$ELSE} 1151d2043 < {$ENDIF} 1157c2049 < PostMessage(Vcl.Forms.Application.Handle, WM_QUIT, 0, 0); --- > PostMessage({$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Handle, WM_QUIT, 0, 0); 1174d2065 < {$IF NOT DEFINED(CLR)} 1176d2066 < {$ENDIF} 1183c2073 < Vcl.Forms.Application.OnException := OnExceptionHandler; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.OnException := OnExceptionHandler; 1186c2076 < if Components[i] is TService then Inc(ServiceCount); --- > if Components[i] is TDDService then Inc(ServiceCount); 1188d2077 < {$IF NOT DEFINED(CLR)} 1190d2078 < {$ENDIF} 1193c2081 < if Components[i] is TService then --- > if Components[i] is TDDService then 1195,1199c2083 < {$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); 1201d2084 < {$ENDIF} 1206c2089 < while not Vcl.Forms.Application.Terminated do --- > while not {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminated do 1208c2091 < Vcl.Forms.Application.HandleMessage; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HandleMessage; 1213,1216c2096 < Vcl.Forms.Application.Terminate; < {$IF DEFINED(CLR)} < DoneServiceApplication; < {$ENDIF} --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminate; 1235a2116,2196 > { 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; > 1236a2198 > InitializeCriticalSection(CritSectWndClass); 1237a2200 > 1238a2202 > DeleteCriticalSection(CritSectWndClass);