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} 12c76,78 < {$HPPEMIT LEGACYHPP} --- > {$IFDEF COMPILER26_UP} > {$HPPEMIT LEGACYHPP} > {$ENDIF} 16a83,87 > {$IFDEF VER_UNKNOWN} > {$MESSAGE WARN 'You are compiling DDService with an unknown compiler version.'} > {$ENDIF} > > {$IFDEF COMPILER16_UP} 18,19c89,101 < {$IF DEFINED(CLR)} < System.Security.Permissions, System.ComponentModel.Design.Serialization, --- > Winapi.Windows, Winapi.Messages, Winapi.WinSvc, System.SysUtils, > System.Classes, DDWindows, DDWinSvc, > {$IFDEF COMPILER17_UP} > System.UITypes, > {$ENDIF} > DDSvcConsts; > {$ELSE} > uses > Windows, Messages, WinSvc, SysUtils, Classes, > {$IFNDEF COMPILER6_UP} > Forms, > {$ENDIF} > DDWindows, DDWinSvc, DDSvcConsts; 21c103,107 < Winapi.Windows, Winapi.Messages, Winapi.WinSvc, System.SysUtils, System.Classes; --- > > const > CUSTOMCONTROL_LOW = 128; > CUSTOMCONTROL_HIGH = 255; > DEFAULT_PRESHUTDOWN_TIMEOUT = 180000; 26a113,117 > {$IFNDEF COMPATIBILITY} > TEventLogType = (etError, etWarning, etInformation, etAuditSuccess, > etAuditFailure); > {$ENDIF} > 31,34d121 < {$IF DEFINED(CLR)} < strict protected < procedure Finalize; override; < {$ENDIF} 38c125,130 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; > {$IFNDEF COMPATIBILITY} > EventType: TEventLogType = etError; > {$ELSE} > EventType: DWord = EVENTLOG_ERROR_TYPE; > {$ENDIF} 73c165,168 < 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 77c172 < TService = class; --- > TDDService = class; 79,81d173 < {$IF DEFINED(CLR)} < TServiceThread = class(TWin32Thread) < {$ELSE} 83d174 < {$ENDIF} 85c176 < FService: TService; --- > FService: TDDService; 88,90c179 < {$IF DEFINED(CLR)} < property Terminated; < {$ENDIF} --- > 92c181 < constructor Create(Service: TService); --- > constructor Create(Service: TDDService); 96c185 < { TService } --- > { TFailureAction } 98c187 < TServiceController = THandlerFunction; --- > TFailureActionType = (faNone, faRestart, faReboot, faRunCommand); 100c189,202 < 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; 102,103c204 < TCurrentStatus = (csStopped, csStartPending, csStopPending, csRunning, < csContinuePending, csPausePending, csPaused); --- > { TFailureActions } 105c206,236 < 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; > > { TDDService } 107c238,242 < TStartType = (stBoot, stSystem, stAuto, stManual, stDisabled); --- > {$IFDEF WIN64} > TDDIntPtr = type Int64; > {$ELSE} > TDDIntPtr = type Integer; > {$ENDIF} 109,113c244,268 < 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; --- > 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; 115,116c270 < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] < TService = class(TDataModule) --- > TDDService = class(TDataModule) 117a272 > FServiceStatus: TServiceStatus; 119a275,277 > FAllowedExControls: TAllowedExControls; > FConsoleHandler: Pointer; > FPreShutdownTimeout: Integer; 120a279 > FDescription: String; 121a281 > FServiceName: String; 124a285,286 > FFailureActions: TFailureActions; > FFailureOptions: TFailureOptions; 125a288 > FImagePath: String; 128a292 > FRequiredPrivileges: TStrings; 130a295 > FExOptions: TExOptions; 131a297 > FServiceSidType: TServiceSidType; 135a302 > FServiceWindow: Hwnd; 141a309 > FTriggerStarted: Boolean; 142a311 > FOnDeviceEvent: TMessageEvent; 143a313,314 > //FOnHardwareProfileChange: TMessageEvent; > FOnNetBindChange: TControlEvent; 144a316 > FOnPowerEvent: TMessageEvent; 145a318,319 > FOnPreShutdown: TServiceEvent; > FOnParamChange: TServiceEvent; 147a322,325 > FOnSessionChange: TSessionChangeEvent; > FOnCustomControl: TCustomControlEvent; > FOnConsoleEvent: TConsoleEvent; > FOnRunException: TServiceExceptionEvent; 148a327,328 > function GetServiceName: String; > procedure SetServiceName(const Value: String); 157c337 < function GetNTControlsAccepted: Integer; --- > function GetNTControlsAccepted: DWORD; 160a341 > procedure SetOnConsoleEvent(Value: TConsoleEvent); 162a344,346 > function AreFailureActionsStored: Boolean; > procedure SetFailureOptions(Value: TFailureOptions); > procedure SetFailureActions(Value: TFailureActions); 165a350,362 > 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); 166a364,368 > {$IFDEF COMPILER16_UP} > procedure Main(Argc: DWord; Argv: PLPWSTR); > {$ELSE} > procedure Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 167a370,371 > function ControllerEx(CtrlCode, EventType: DWord; EventData, Context: Pointer): DWord; > function ConsoleCtrlHandler(Ctrl: DWord): LongBool; 169,171c373,375 < function DoStop: Boolean; virtual; < function DoPause: Boolean; virtual; < function DoContinue: Boolean; virtual; --- > function DoStop: Boolean; virtual; > function DoPause: Boolean; virtual; > function DoContinue: Boolean; virtual; 174,179c378,389 < 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; 184a395,396 > function GetServiceControllerEx: TServiceControllerEx; virtual; abstract; > function GetConsoleCtrlHandler: TServiceConsoleCtrlHandler; virtual; abstract; 186c398 < procedure LogMessage(Message: String; EventType: DWord = 1; --- > procedure LogMessage(Msg: String; {$IFNDEF COMPATIBILITY}EventType: TEventLogType = etError;{$ELSE}EventType: DWord = 1;{$ENDIF} 187a400 > procedure Stop; 188a402 > property ImagePath: String read FImagePath write FImagePath; 193a408,409 > property TriggerStarted: Boolean read FTriggerStarted; > property ServiceWindow: HWND read FServiceWindow; 197a414 > property AllowedExControls: TAllowedExControls read FAllowedExControls write FAllowedExControls default []; 199c416,418 < 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; 200a420,422 > 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; 203a426,427 > property PreShutdownTimeout: Integer read FPreShutdownTimeout write FPreShutdownTimeout default DEFAULT_PRESHUTDOWN_TIMEOUT; > property RequiredPrivileges: TStrings read FRequiredPrivileges write SetRequiredPrivileges; 206a431 > property ServiceSidType: TServiceSidType read FServiceSidType write FServiceSidType default stNone; 213a439 > property OnDeviceEvent: TMessageEvent read FOnDeviceEvent write SetOnDeviceEvent; 214a441,442 > property OnNetBindChange: TControlEvent read FOnNetBindChange write SetOnNetBindChange; > property OnParamChange: TServiceEvent read FOnParamChange write SetOnParamChange; 215a444,445 > property OnPowerEvent: TMessageEvent read FOnPowerEvent write SetOnPowerEvent; > property OnRunException: TServiceExceptionEvent read FOnRunException write FOnRunException; 218a449,452 > 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; 223,224c457,458 < [RootDesignerSerializerAttribute('', '', False)] < [SecurityPermission(SecurityAction.Demand, Unrestricted=True)] --- > TExceptionEvent = procedure(Sender: TObject; E: Exception; var Handled: Boolean) of object; > 230a465 > FOnException: TExceptionEvent; 236,239c471 < function Hook(var Message: TMessage): Boolean; < {$IF DEFINED(CLR)} < procedure DispatchServiceMain(Argc: DWord; Argv: IntPtr); < {$ELSE} --- > {$IFDEF COMPILER16_UP} 241c473,477 < {$ENDIF} --- > {$ELSE} > procedure DispatchServiceMain(Argc: DWord; Argv: PLPSTR); > {$ENDIF} > function Hook(var Message: TMessage): Boolean; > procedure ChangeServiceConfiguration2(Service: TDDService; hService: THandle); {virtual;} 246a483 > property EventLogger: TEventLogger read FEventLogger; 252a490 > property OnException: TExceptionEvent read FOnException write FOnException; 254a493,494 > function IsValidServiceName(const SvcName: string): Boolean; > 259a500,506 > {$IFDEF COMPILER16_UP} > uses > {$IFDEF COMPILER6_UP} > Vcl.Forms, > {$ENDIF} > Vcl.Dialogs, Vcl.Consts; > {$ELSE} 261,262c508,606 < {$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; 264d607 < System.UITypes, Vcl.Forms, Vcl.Dialogs, Vcl.Consts; 275,283d617 < {$IF DEFINED(CLR)} < procedure TEventLogger.Finalize; < begin < if FEventLog <> 0 then < DeregisterEventSource(FEventLog); < inherited; < end; < {$ENDIF} < 291,293d624 < {$IF DEFINED(CLR)} < System.GC.SuppressFinalize(self); < {$ENDIF} 297,317c628,630 < 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; 318a632,634 > EventType: DWord; > {$ENDIF} > Category: Word; ID: DWord); 320c636 < P: Pointer; --- > PMsg: Pointer; 322c638 < P := PChar(Message); --- > PMsg := PChar(Msg); 325,326c641,645 < 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); 327a647 > end; 363c683,687 < constructor TServiceThread.Create(Service: TService); --- > function ThreadWindowProc(aWnd: HWND; aMsg: UINT; aWParam: WPARAM; > aLParam: LPARAM): LRESULT; stdcall; > var > Obj: TObject; > MsgRec: TMessage; 365,367c689,690 < {$IF DEFINED(CLR)} < inherited Create(True); < FService := Service; --- > {$IFDEF WIN64} > Obj := TObject(GetWindowLongPtr(aWnd, 0)); 368a692,772 > 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 371d774 < {$ENDIF} 388,389c791,792 < if Assigned(FService.OnStart) then FService.OnStart(FService, Started); < if not Started then Exit; --- > if FService.ThreadWindowNeeded then > FService.CheckCreateServiceThreadWindow; 391,399c794,813 < 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; 408,409c822,825 < 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); 413c829 < msg: TMsg; --- > msg: tagMSG; 416a833 > CanAbort: Boolean; 425a843 > 433c851 < case NativeInt(msg.wParam) of --- > case msg.wParam of 438a857,862 > 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; 440c864,865 < ActionOK := FService.DoCustomControl(msg.wParam); --- > {user-defined control code = Range 128 to 255 } > FService.DoCustomControl(msg.wParam); 449,453c874,898 < 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; 456c901,903 < end else --- > end > else begin > TranslateMessage(msg); 458c905,908 < end else --- > end; > end > else begin > TranslateMessage(msg); 459a910,938 > 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; 463c942 < { TService } --- > { TDDService } 465c944 < constructor TService.Create(AOwner: TComponent); --- > constructor TDDService.Create(AOwner: TComponent); 467c946,948 < inherited; --- > { This dummy exists only to get C++ Builder working correctly otherwise } > { some non-initialized string and set properties. } > inherited Create(AOwner); 470c951 < constructor TService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); --- > constructor TDDService.CreateNew(AOwner: TComponent; Dummy: Integer = 0); 482a964,971 > 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]; 485c974 < destructor TService.Destroy; --- > destructor TDDService.Destroy; 489a979,981 > FFailureOptions.Free; > FFailureActions.Free; > FRequiredPrivileges.Free; 493c985 < function TService.GetDisplayName: String; --- > function TDDService.GetDisplayName: String; 501c993,1008 < 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); 512c1019 < procedure TService.SetPassword(const Value: string); --- > procedure TDDService.SetPassword(const Value: String); 520c1027 < procedure TService.SetServiceStartName(const Value: string); --- > procedure TDDService.SetServiceStartName(const Value: String); 528c1035 < procedure TService.SetDependencies(Value: TDependencies); --- > procedure TDDService.SetDependencies(Value: TDependencies); 533c1040 < function TService.AreDependenciesStored: Boolean; --- > function TDDService.AreDependenciesStored: Boolean; 538c1045,1050 < function TService.GetParamCount: Integer; --- > function TDDService.AreFailureActionsStored: Boolean; > begin > Result := FFailureActions.Count > 0; > end; > > function TDDService.GetParamCount: Integer; 543c1055 < function TService.GetParam(Index: Integer): String; --- > function TDDService.GetParam(Index: Integer): String; 548c1060 < procedure TService.SetOnContinue(Value: TContinueEvent); --- > procedure TDDService.SetOnContinue(Value: TContinueEvent); 554c1066 < procedure TService.SetOnPause(Value: TPauseEvent); --- > procedure TDDService.SetOnPause(Value: TPauseEvent); 560c1072 < procedure TService.SetOnStop(Value: TStopEvent); --- > procedure TDDService.SetOnStop(Value: TStopEvent); 566c1078,1132 < 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; 573c1139 < function TService.GetNTDependencies: String; --- > function TDDService.GetNTDependencies: String; 575,580c1141 < {$IF DEFINED(CLR)} < I, J, Len: Integer; < Pos: Integer; < Temp: string; < {$ELSE} < I, Len: Integer; --- > i, Len: Integer; 582d1142 < {$ENDIF} 591,615d1150 < {$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} 633d1167 < {$ENDIF} 640c1174 < function TService.GetNTServiceType: DWORD; --- > function TDDService.GetNTServiceType: DWORD; 652c1186 < SERVICE_DISABLED); --- > SERVICE_DISABLED, SERVICE_AUTO_START); 654c1188 < function TService.GetNTStartType: DWORD; --- > function TDDService.GetNTStartType: DWORD; 661c1195 < function TService.GetNTErrorSeverity: DWORD; --- > function TDDService.GetNTErrorSeverity: DWORD; 669c1203 < function TService.GetNTControlsAccepted: Integer; --- > function TDDService.GetNTControlsAccepted: DWORD; 673a1208,1225 > > 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; 676c1228,1234 < 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); 679,680c1237,1238 < FEventLogger := TEventLogger.Create(Name); < FEventLogger.LogMessage(Message, EventType, Category, ID); --- > FEventLogger := TEventLogger.Create(ServiceName); > FEventLogger.LogMessage(Msg, EventType, Category, ID); 686,687c1244,1245 < 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); 689c1247 < csContinuePending, csPausePending]; --- > csContinuePending, csPausePending]; 691,693c1249,1251 < procedure TService.ReportStatus; < var < ServiceStatus: TServiceStatus; --- > procedure TDDService.ReportStatus; > {var > ServiceStatus: TServiceStatus; } 695c1253 < with ServiceStatus do --- > with FServiceStatus do 700c1258,1259 < dwControlsAccepted := 0 else --- > dwControlsAccepted := 0 > else 701a1261 > 703c1263,1264 < Inc(dwCheckPoint) else --- > Inc(dwCheckPoint) > else 711,712c1272,1273 < if not SetServiceStatus(FStatusHandle, ServiceStatus) then < LogMessage(SysErrorMessage(GetLastError)); --- > if not SetServiceStatus(FStatusHandle, FServiceStatus) then > LogMessage('ReportStatus: ' + SysErrorMessage(GetLastError)); 716c1277 < procedure TService.SetStatus(Value: TCurrentStatus); --- > procedure TDDService.SetStatus(Value: TCurrentStatus); 723,728c1284 < {$IF DEFINED(CLR)} < procedure TService.Main(Argc: DWord; Argv: IntPtr); < var < i: Integer; < Controller: TServiceController; < PStr: IntPtr; --- > procedure TDDService.Stop; 730c1286 < for i := 0 to Argc - 1 do --- > if Assigned(ServiceThread) then 732,733c1288,1290 < 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); 735,740d1291 < Controller := Self.GetServiceController(); < FStatusHandle := RegisterServiceCtrlHandler(Name, Controller); < if (FStatusHandle = 0) then < LogMessage(SysErrorMessage(GetLastError)) < else < DoStart; 741a1293,1295 > > {$IFDEF COMPILER16_UP} > procedure TDDService.Main(Argc: DWord; Argv: PLPWSTR); 743c1297,1298 < procedure TService.Main(Argc: DWord; Argv: PLPWSTR); --- > procedure TDDService.Main(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 749c1304 < Controller: THandlerFunction; --- > Controller: Pointer; 753,754c1308,1318 < 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; 760d1323 < {$ENDIF} 762c1325 < procedure TService.Controller(CtrlCode: DWord); --- > procedure TDDService.Controller(CtrlCode: DWord); 764d1326 < PostThreadMessage(ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, CtrlCode, 0); 765a1328,1409 > 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; > end; > > 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); 768c1412 < procedure TService.DoStart; --- > procedure TDDService.DoStart; 786c1430 < function TService.DoStop: Boolean; --- > function TDDService.DoStop: Boolean; 794c1438,1463 < 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; 802c1471,1472 < ServiceThread.Suspend; --- > if eoSuspendServiceThreadOnPause in FExOptions then > ServiceThread.Suspend; 806c1476 < function TService.DoContinue: Boolean; --- > procedure TDDService.DoCustomControl(CtrlCode: DWord); 807a1478,1508 > 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; 809,812c1510,1511 < Status := csContinuePending; < if Assigned(FOnContinue) then FOnContinue(Self, Result); < if Result then < Status := csRunning; --- > if Assigned(FOnRunException) then > FOnRunException(Self, E, Result, CanAbort); 815c1514 < procedure TService.DoInterrogate; --- > procedure TDDService.DoParamChange; 817a1517,1525 > 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); 820c1528 < procedure TService.DoShutdown; --- > procedure TDDService.DoPreShutdown; 824c1532 < if Assigned(FOnShutdown) then FOnShutdown(Self); --- > if Assigned(FOnPreShutdown) then OnPreShutdown(Self); 826c1534 < { Shutdown cannot abort, it must stop regardless of any exception } --- > { PreShutdown cannot abort, it must stop regardless of any exception } 831c1539,1616 < 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; 832a1618,1623 > 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; 839c1630 < TServiceClass = class of TService; --- > TDDServiceClass = class of TDDService; 841,843c1632 < {$IF DEFINED(CLR)} < procedure ServiceMain(Argc: DWord; Argv: IntPtr); < {$ELSE} --- > {$IFDEF COMPILER16_UP} 844a1634,1635 > {$ELSE} > procedure ServiceMain(Argc: DWord; Argv: PLPSTR); stdcall; 850,854d1640 < {$IF DEFINED(CLR)} < const < ServiceMainDelegate: TServiceMainFunction = @ServiceMain; < {$ENDIF} < 856a1643 > {$IFDEF COMPILER16_UP} 857a1645,1647 > {$ELSE} > with Forms.Application do > {$ENDIF} 877c1667 < Vcl.Forms.Application.HookMainWindow(Hook); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HookMainWindow(Hook); 882,884c1672,1675 < 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); 888,905c1679 < {$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} 906a1681,1683 > {$ELSE} > procedure TServiceApplication.DispatchServiceMain(Argc: DWord; Argv: PLPSTR); > {$ENDIF} 911,912c1688,1689 < 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 914c1691 < TService(Components[i]).Main(Argc, Argv); --- > TDDService(Components[i]).Main(Argc, Argv); 918d1694 < {$ENDIF} 926c1702 < if Components[i] is TService then --- > if Components[i] is TDDService then 929a1706,1850 > 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; > 932c1853 < procedure InstallService(Service: TService; SvcMgr: SC_HANDLE); --- > procedure InstallService(Service: TDDService; SvcMgr: SC_HANDLE); 934,936d1854 < {$IF DEFINED(CLR)} < TmpTagID: DWORD; < {$ELSE} 940d1857 < {$ENDIF} 942d1858 < Path: string; 944,946d1859 < Path := ParamStr(0); < if Pos(' ', Path) > 0 then < Path := '"' + Path + '"'; 949,968c1862,1864 < 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; 969a1866 > 971c1868,1869 < PSSN := nil else --- > PSSN := nil > else 973,977c1871,1885 < 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)); > 978a1887 > 982a1892 > ChangeServiceConfiguration2(Service, Svc); 997c1907 < procedure UninstallService(Service: TService; SvcMgr: SC_HANDLE); --- > procedure UninstallService(Service: TDDService; SvcMgr: SC_HANDLE); 1004,1008c1914 < {$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); 1034,1036d1939 < {$IF DEFINED(CLR)} < SvcMgr := OpenSCManager('', nil, SC_MANAGER_ALL_ACCESS); < {$ELSE} 1038d1940 < {$ENDIF} 1042c1944 < if Components[i] is TService then --- > if Components[i] is TDDService then 1045c1947 < InstallService(TService(Components[i]), SvcMgr) --- > InstallService(TDDService(Components[i]), SvcMgr) 1047c1949 < UninstallService(TService(Components[i]), SvcMgr) --- > UninstallService(TDDService(Components[i]), SvcMgr); 1056c1958 < with TService(Components[i]) do --- > with TDDService(Components[i]) do 1078c1980 < if InstanceClass.InheritsFrom(TService) then --- > if InstanceClass.InheritsFrom(TDDService) then 1080,1087d1981 < {$IF DEFINED(CLR)} < try < Reference := TServiceClass(InstanceClass).Create(Self); < except < Reference := nil; < raise; < end; < {$ELSE} 1094d1987 < {$ENDIF} 1096c1989 < Vcl.Forms.Application.CreateForm(InstanceClass, Reference); --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.CreateForm(InstanceClass, Reference); 1109,1110c2002,2003 < 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; 1124a2018,2019 > var > Handled : Boolean; 1126c2021,2025 < DoHandleException(E); --- > Handled := FALSE; > if Assigned(FOnException) then > FOnException(Sender, E, Handled); > if not Handled then > DoHandleException(E); 1138,1140d2036 < {$IF DEFINED(CLR)} < property ReturnValue; < {$ENDIF} 1147,1153d2042 < {$IF DEFINED(CLR)} < inherited Create(True); < FreeOnTerminate := False; < ReturnValue := 0; < FServiceStartTable := Services; < Resume; < {$ELSE} 1158d2046 < {$ENDIF} 1164c2052 < PostMessage(Vcl.Forms.Application.Handle, WM_QUIT, 0, 0); --- > PostMessage({$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Handle, WM_QUIT, 0, 0); 1181d2068 < {$IF NOT DEFINED(CLR)} 1183d2069 < {$ENDIF} 1190c2076 < Vcl.Forms.Application.OnException := OnExceptionHandler; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.OnException := OnExceptionHandler; 1193c2079 < if Components[i] is TService then Inc(ServiceCount); --- > if Components[i] is TDDService then Inc(ServiceCount); 1195d2080 < {$IF NOT DEFINED(CLR)} 1197d2081 < {$ENDIF} 1200c2084 < if Components[i] is TService then --- > if Components[i] is TDDService then 1202,1206c2086 < {$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); 1208d2087 < {$ENDIF} 1213c2092 < while not Vcl.Forms.Application.Terminated do --- > while not {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminated do 1215c2094 < Vcl.Forms.Application.HandleMessage; --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.HandleMessage; 1220,1223c2099 < Vcl.Forms.Application.Terminate; < {$IF DEFINED(CLR)} < DoneServiceApplication; < {$ENDIF} --- > {$IFDEF COMPILER16_UP}Vcl.{$ENDIF}Forms.Application.Terminate; 1242a2119,2199 > { 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; > 1243a2201 > InitializeCriticalSection(CritSectWndClass); 1244a2203 > 1245a2205 > DeleteCriticalSection(CritSectWndClass);