├── .gitignore ├── Demos └── FirebirdService │ ├── FirbirdService.MainForm.dfm │ ├── FirbirdService.MainForm.pas │ ├── FirbirdService.dpr │ ├── FirbirdService.dproj │ └── FirbirdService.res ├── LICENSE ├── README.md ├── Windows.ServiceManager.Consts.pas ├── Windows.ServiceManager.Types.pas └── Windows.ServiceManager.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | *.dsv 71 | -------------------------------------------------------------------------------- /Demos/FirebirdService/FirbirdService.MainForm.dfm: -------------------------------------------------------------------------------- 1 | object FormFirebierdServiceMain: TFormFirebierdServiceMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'FormFirebierdServiceMain' 5 | ClientHeight = 411 6 | ClientWidth = 1200 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | OnDestroy = FormDestroy 15 | TextHeight = 15 16 | object MemoLog: TMemo 17 | Left = 0 18 | Top = 0 19 | Width = 917 20 | Height = 411 21 | Align = alClient 22 | Font.Charset = DEFAULT_CHARSET 23 | Font.Color = clWindowText 24 | Font.Height = -15 25 | Font.Name = 'Courier New' 26 | Font.Style = [] 27 | ParentFont = False 28 | ScrollBars = ssVertical 29 | TabOrder = 0 30 | end 31 | object PanelRight: TPanel 32 | Left = 917 33 | Top = 0 34 | Width = 283 35 | Height = 411 36 | Align = alRight 37 | BevelOuter = bvNone 38 | ShowCaption = False 39 | TabOrder = 1 40 | object ButtonQueryFirebird: TButton 41 | AlignWithMargins = True 42 | Left = 3 43 | Top = 3 44 | Width = 277 45 | Height = 25 46 | Align = alTop 47 | Caption = 'Query Firebird' 48 | TabOrder = 0 49 | OnClick = ButtonQueryFirebirdClick 50 | end 51 | object ButtonEnumerateServices: TButton 52 | AlignWithMargins = True 53 | Left = 3 54 | Top = 34 55 | Width = 277 56 | Height = 25 57 | Align = alTop 58 | Caption = 'Enumerate services' 59 | TabOrder = 1 60 | OnClick = ButtonEnumerateServicesClick 61 | end 62 | object ButtonStartFirebirdService: TButton 63 | AlignWithMargins = True 64 | Left = 3 65 | Top = 65 66 | Width = 277 67 | Height = 25 68 | Align = alTop 69 | Caption = 'Start Firebird service' 70 | TabOrder = 2 71 | OnClick = ButtonStartFirebirdServiceClick 72 | end 73 | object ButtonStopFirebirdService: TButton 74 | AlignWithMargins = True 75 | Left = 3 76 | Top = 96 77 | Width = 277 78 | Height = 25 79 | Align = alTop 80 | Caption = 'Stop Firebird service' 81 | TabOrder = 3 82 | OnClick = ButtonStopFirebirdServiceClick 83 | end 84 | object ButtonFixFirebirdService: TButton 85 | AlignWithMargins = True 86 | Left = 3 87 | Top = 127 88 | Width = 277 89 | Height = 25 90 | Align = alTop 91 | Caption = 'Fix Firebird service' 92 | TabOrder = 4 93 | OnClick = ButtonFixFirebirdServiceClick 94 | end 95 | object ButtonTestErrorHandler: TButton 96 | AlignWithMargins = True 97 | Left = 3 98 | Top = 158 99 | Width = 277 100 | Height = 25 101 | Align = alTop 102 | Caption = 'Test error handler' 103 | TabOrder = 5 104 | OnClick = ButtonTestErrorHandlerClick 105 | end 106 | object ButtonEumerateWindowsAudioServiceDependencies: TButton 107 | AlignWithMargins = True 108 | Left = 3 109 | Top = 189 110 | Width = 277 111 | Height = 25 112 | Align = alTop 113 | Caption = 'Eumerate Windows Audio Dependencies' 114 | TabOrder = 6 115 | OnClick = ButtonEumerateWindowsAudioServiceDependenciesClick 116 | end 117 | end 118 | end 119 | -------------------------------------------------------------------------------- /Demos/FirebirdService/FirbirdService.MainForm.pas: -------------------------------------------------------------------------------- 1 | unit FirbirdService.MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Messages, Winapi.Windows, System.Classes, System.SysUtils, System.Variants, Vcl.Controls, Vcl.Dialogs, 7 | Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.StdCtrls, IdBaseComponent, IdComponent, IdTCPClient, IdTCPConnection, 8 | Windows.ServiceManager; 9 | 10 | type 11 | TFormFirebierdServiceMain = class(TForm) 12 | ButtonEnumerateServices: TButton; 13 | ButtonEumerateWindowsAudioServiceDependencies: TButton; 14 | ButtonFixFirebirdService: TButton; 15 | ButtonQueryFirebird: TButton; 16 | ButtonStartFirebirdService: TButton; 17 | ButtonStopFirebirdService: TButton; 18 | ButtonTestErrorHandler: TButton; 19 | MemoLog: TMemo; 20 | PanelRight: TPanel; 21 | procedure ButtonEnumerateServicesClick(Sender: TObject); 22 | procedure ButtonEumerateWindowsAudioServiceDependenciesClick(Sender: TObject); 23 | procedure ButtonFixFirebirdServiceClick(Sender: TObject); 24 | procedure ButtonQueryFirebirdClick(Sender: TObject); 25 | procedure ButtonStartFirebirdServiceClick(Sender: TObject); 26 | procedure ButtonStopFirebirdServiceClick(Sender: TObject); 27 | procedure ButtonTestErrorHandlerClick(Sender: TObject); 28 | procedure FormCreate(Sender: TObject); 29 | procedure FormDestroy(Sender: TObject); 30 | strict private 31 | FServciceManager: TServiceManager; 32 | function GetLogIndent(const AIndent: Integer): string; 33 | function GetServiceNamesString(const AServiceInfo: TServiceInfo): string; 34 | function RemoveLineBreaks(const AMessage: string): string; 35 | procedure ActivateOrRefreshServiceManager(const AGetServiceListOnActive: Boolean); 36 | procedure Log(const AException: Exception; const AIndent: Integer = 0); overload; 37 | procedure Log(const AMessage: string; const AIndent: Integer = 0); overload; 38 | public 39 | { Public declarations } 40 | end; 41 | 42 | var 43 | FormFirebierdServiceMain: TFormFirebierdServiceMain; 44 | 45 | implementation 46 | 47 | uses 48 | System.StrUtils, Windows.ServiceManager.Types; 49 | 50 | const 51 | FIREBIRD_DEFAULT_SERVICE_NAME = 'FirebirdServerDefaultInstance'; 52 | 53 | {$R *.dfm} 54 | 55 | procedure TFormFirebierdServiceMain.ActivateOrRefreshServiceManager(const AGetServiceListOnActive: Boolean); 56 | begin 57 | if not FServciceManager.Active then 58 | begin 59 | FServciceManager.GetServiceListOnActive := AGetServiceListOnActive; 60 | FServciceManager.Active := True 61 | end 62 | else 63 | FServciceManager.RebuildServicesList; 64 | end; 65 | 66 | procedure TFormFirebierdServiceMain.ButtonEnumerateServicesClick(Sender: TObject); 67 | var 68 | LServices: TArray; 69 | LService: TServiceInfo; 70 | begin 71 | Log('Enumerate services...'); 72 | 73 | try 74 | ActivateOrRefreshServiceManager(True); 75 | 76 | LServices := FServciceManager.GetServicesByDisplayName; 77 | 78 | MemoLog.Lines.BeginUpdate; 79 | try 80 | for LService in LServices do 81 | begin 82 | Log(GetServiceNamesString(LService), 1); 83 | end; 84 | 85 | Log('', 0); 86 | Log('Service Count: ' + Length(LServices).ToString, 1); 87 | finally 88 | MemoLog.Lines.EndUpdate; 89 | end; 90 | except 91 | on E: Exception do 92 | Log(E, 2); 93 | end; 94 | 95 | Log(''); 96 | end; 97 | 98 | procedure TFormFirebierdServiceMain.ButtonEumerateWindowsAudioServiceDependenciesClick(Sender: TObject); 99 | const 100 | WINDOWS_AUDIO_SERVICE_NAME = 'Audiosrv'; 101 | var 102 | LDepedencies: TArray; 103 | LService: TServiceInfo; 104 | LDependantService: TServiceInfo; 105 | LDepedencyCount: Integer; 106 | begin 107 | LDepedencyCount := 0; 108 | 109 | try 110 | ActivateOrRefreshServiceManager(True); 111 | 112 | LService := FServciceManager.ServiceByName(WINDOWS_AUDIO_SERVICE_NAME); 113 | if not Assigned(LService) then 114 | raise Exception.Create('Service not found'); 115 | 116 | Log('Eumerate "' + LService.DisplayName + '" service Dependencies...'); 117 | MemoLog.Lines.BeginUpdate; 118 | try 119 | LDepedencies := LService.Dependents; 120 | 121 | for LDependantService in LDepedencies do 122 | begin 123 | if Assigned(LDependantService) then 124 | begin 125 | Log(GetServiceNamesString(LDependantService), 1); 126 | Inc(LDepedencyCount); 127 | end; 128 | end; 129 | 130 | Log('', 0); 131 | Log('Dependent service(s) Count: ' + LDepedencyCount.ToString, 1); 132 | finally 133 | MemoLog.Lines.EndUpdate; 134 | end; 135 | except 136 | on E: Exception do 137 | Log(E, 2); 138 | end; 139 | 140 | Log(''); 141 | end; 142 | 143 | procedure TFormFirebierdServiceMain.ButtonFixFirebirdServiceClick(Sender: TObject); 144 | var 145 | LServciceManager: TServiceManager; 146 | LFirebirdService: TServiceInfo; 147 | begin 148 | Log('Fixing Firebird service...'); 149 | 150 | LServciceManager := TServiceManager.Create; 151 | try 152 | try 153 | try 154 | LServciceManager.BeginLockingProcess; 155 | LFirebirdService := LServciceManager.ServiceByName(FIREBIRD_DEFAULT_SERVICE_NAME); 156 | 157 | if LFirebirdService.State = ssRunning then 158 | begin 159 | Log('Stopping service...', 1); 160 | LFirebirdService.Stop; 161 | end; 162 | 163 | if LFirebirdService.StartType <> ssAutomatic then 164 | begin 165 | Log('Changing Service Start Type to: Automatic', 1); 166 | LFirebirdService.StartType := ssAutomatic; 167 | end; 168 | 169 | if LFirebirdService.State <> ssRunning then 170 | begin 171 | Log('Starting service...', 1); 172 | LFirebirdService.Start; 173 | end; 174 | 175 | Log('Service state: ' + ServiceStateToString(LFirebirdService.State), 1); 176 | finally 177 | LServciceManager.EndLockingProcess; 178 | end; 179 | finally 180 | LServciceManager.Free; 181 | end; 182 | 183 | Log(''); 184 | except 185 | on E: Exception do 186 | Log(E, 2); 187 | end; 188 | end; 189 | 190 | procedure TFormFirebierdServiceMain.ButtonQueryFirebirdClick(Sender: TObject); 191 | var 192 | LServiceRunning: Boolean; 193 | LFirebirdService: TServiceInfo; 194 | begin 195 | Log('Query Firebird service status...'); 196 | 197 | try 198 | ActivateOrRefreshServiceManager(False); 199 | 200 | LFirebirdService := FServciceManager.ServiceByName(FIREBIRD_DEFAULT_SERVICE_NAME); 201 | 202 | LServiceRunning := LFirebirdService.State = ssRunning; 203 | Log(IfThen(LServiceRunning, 'Firebird Service Running', 'Firebird Service NOT Running'), 1); 204 | 205 | Log('DisplayName: "' + LFirebirdService.DisplayName + '"', 2); 206 | Log('Path: "' + LFirebirdService.Path + '"', 2); 207 | Log('File name: "' + LFirebirdService.FileName + '"', 2); 208 | Log('Command line: "' + LFirebirdService.CommandLine + '"', 2); 209 | except 210 | on E: Exception do 211 | Log(E, 2); 212 | end; 213 | 214 | Log(''); 215 | end; 216 | 217 | procedure TFormFirebierdServiceMain.ButtonStartFirebirdServiceClick(Sender: TObject); 218 | var 219 | LFirebirdService: TServiceInfo; 220 | begin 221 | Log('Starting Firebird service...'); 222 | 223 | try 224 | ActivateOrRefreshServiceManager(True); 225 | 226 | LFirebirdService := FServciceManager.ServiceByName(FIREBIRD_DEFAULT_SERVICE_NAME); 227 | 228 | if LFirebirdService.State <> ssRunning then 229 | begin 230 | Log('Starting service...', 1); 231 | LFirebirdService.Start; 232 | 233 | Log('Service state: ' + ServiceStateToString(LFirebirdService.State), 1); 234 | end 235 | else 236 | Log('Firebird service already running', 1); 237 | except 238 | on E: Exception do 239 | Log(E, 2); 240 | end; 241 | 242 | Log(''); 243 | end; 244 | 245 | procedure TFormFirebierdServiceMain.ButtonStopFirebirdServiceClick(Sender: TObject); 246 | var 247 | LFirebirdService: TServiceInfo; 248 | begin 249 | Log('Stopping Firebird service...'); 250 | 251 | try 252 | ActivateOrRefreshServiceManager(True); 253 | 254 | LFirebirdService := FServciceManager.ServiceByName(FIREBIRD_DEFAULT_SERVICE_NAME); 255 | 256 | if LFirebirdService.State <> ssStopped then 257 | begin 258 | Log('Stopping service...', 1); 259 | LFirebirdService.Stop; 260 | 261 | Log('Service state: ' + ServiceStateToString(LFirebirdService.State), 1); 262 | end 263 | else 264 | Log('Firebird service already stopped', 1); 265 | except 266 | on E: Exception do 267 | Log(E, 2); 268 | end; 269 | 270 | Log(''); 271 | end; 272 | 273 | procedure TFormFirebierdServiceMain.ButtonTestErrorHandlerClick(Sender: TObject); 274 | var 275 | LServciceManager: TServiceManager; 276 | LExceptionRaised: Boolean; 277 | begin 278 | Log('Testing error handler...'); 279 | 280 | Log('Raise Exceptions', 1); 281 | LServciceManager := TServiceManager.Create; 282 | try 283 | try 284 | LExceptionRaised := False; 285 | LServciceManager.RaiseExceptions := True; 286 | 287 | LServciceManager.RebuildServicesList; 288 | except 289 | on E: Exception do 290 | begin 291 | LExceptionRaised := True; 292 | Log(E, 2); 293 | end; 294 | end; 295 | 296 | if not LExceptionRaised or (LServciceManager.LastErrorCode = 0) or (LServciceManager.LAstErrorMessage.IsEmpty) then 297 | raise Exception.Create('Error handler did not work'); 298 | 299 | Log('Do not raise Exceptions', 1); 300 | try 301 | LExceptionRaised := False; 302 | LServciceManager.RaiseExceptions := False; 303 | 304 | LServciceManager.RebuildServicesList; 305 | except 306 | on E: Exception do 307 | begin 308 | LExceptionRaised := True; 309 | Log(E, 2); 310 | end; 311 | end; 312 | 313 | if LExceptionRaised or (LServciceManager.LastErrorCode = 0) or (LServciceManager.LAstErrorMessage.IsEmpty) then 314 | raise Exception.Create('Error handler did not work') 315 | else 316 | Log(LServciceManager.LastErrorMessage, 2); 317 | finally 318 | LServciceManager.Free; 319 | end; 320 | 321 | Log(''); 322 | end; 323 | 324 | procedure TFormFirebierdServiceMain.FormCreate(Sender: TObject); 325 | begin 326 | FServciceManager := TServiceManager.Create; 327 | end; 328 | 329 | procedure TFormFirebierdServiceMain.FormDestroy(Sender: TObject); 330 | begin 331 | FServciceManager.Free; 332 | end; 333 | 334 | function TFormFirebierdServiceMain.GetLogIndent(const AIndent: Integer): string; 335 | begin 336 | if AIndent > 0 then 337 | Result := StringOfChar(' ', AIndent * 2) + '- ' 338 | else 339 | Result := ''; 340 | end; 341 | 342 | function TFormFirebierdServiceMain.GetServiceNamesString(const AServiceInfo: TServiceInfo): string; 343 | begin 344 | Result := AServiceInfo.DisplayName + ' (' + AServiceInfo.Name + ')'; 345 | end; 346 | 347 | procedure TFormFirebierdServiceMain.Log(const AMessage: string; const AIndent: Integer = 0); 348 | var 349 | LIndent: string; 350 | begin 351 | LIndent := GetLogIndent(AIndent); 352 | 353 | MemoLog.Lines.Add(LIndent + RemoveLineBreaks(AMessage)); 354 | end; 355 | 356 | procedure TFormFirebierdServiceMain.Log(const AException: Exception; const AIndent: Integer = 0); 357 | begin 358 | Log('Exception ' + AException.ClassName + ' occurent, with message: "' + AException.Message + '"', AIndent); 359 | Log(''); 360 | end; 361 | 362 | function TFormFirebierdServiceMain.RemoveLineBreaks(const AMessage: string): string; 363 | begin 364 | // Just quick and dirty way to get error message into one log line 365 | Result := AMessage.Replace(#13, ' ', [rfReplaceAll]); 366 | Result := Result.Replace(#10, '', [rfReplaceAll]); 367 | Result := Result.Replace(' ', ' ', [rfReplaceAll]); // Duplicate spaces to one 368 | end; 369 | 370 | end. 371 | -------------------------------------------------------------------------------- /Demos/FirebirdService/FirbirdService.dpr: -------------------------------------------------------------------------------- 1 | program FirbirdService; 2 | 3 | uses 4 | Vcl.Forms, 5 | FirbirdService.MainForm in 'FirbirdService.MainForm.pas' {FormFirebierdServiceMain}, 6 | Windows.ServiceManager in '..\..\Windows.ServiceManager.pas', 7 | Windows.ServiceManager.Types in '..\..\Windows.ServiceManager.Types.pas', 8 | Windows.ServiceManager.Consts in '..\..\Windows.ServiceManager.Consts.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TFormFirebierdServiceMain, FormFirebierdServiceMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/FirebirdService/FirbirdService.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {A1BC0065-62C4-4CAE-A611-C8CBBCBB144C} 4 | FirbirdService.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 20.3 11 | Win32 12 | FirbirdService 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Cfg_1 35 | true 36 | true 37 | 38 | 39 | true 40 | Base 41 | true 42 | 43 | 44 | true 45 | Cfg_2 46 | true 47 | true 48 | 49 | 50 | false 51 | false 52 | false 53 | false 54 | false 55 | 00400000 56 | FirbirdService 57 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 58 | 1035 59 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 60 | ..\..\;$(DCC_UnitSearchPath) 61 | .\$(Platform)\$(Config) 62 | .\$(Platform)\$(Config) 63 | 64 | 65 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 66 | Debug 67 | true 68 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 69 | 1033 70 | $(BDS)\bin\default_app.manifest 71 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 72 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 73 | $(BDS)\bin\delphi_PROJECTICON.ico 74 | none 75 | 76 | 77 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 78 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 79 | 80 | 81 | RELEASE;$(DCC_Define) 82 | 0 83 | false 84 | 0 85 | 86 | 87 | PerMonitorV2 88 | true 89 | 1033 90 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 91 | 92 | 93 | DEBUG;$(DCC_Define) 94 | false 95 | true 96 | true 97 | true 98 | off 99 | true 100 | error 101 | 102 | 103 | PerMonitorV2 104 | true 105 | 1033 106 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 107 | 108 | 109 | 110 | MainSource 111 | 112 | 113 |
FormFirebierdServiceMain
114 | 115 | 116 | 117 | 118 | 119 | Base 120 | 121 | 122 | Cfg_1 123 | Base 124 | 125 | 126 | Cfg_2 127 | Base 128 | 129 | 130 | 131 | Delphi.Personality.12 132 | 133 | 134 | 135 | 136 | FirbirdService.dpr 137 | 138 | 139 | Microsoft Office 2000 Sample Automation Server Wrapper Components 140 | Microsoft Office XP Sample Automation Server Wrapper Components 141 | 142 | 143 | 144 | True 145 | False 146 | 147 | 148 | 149 | 150 | 151 | 1 152 | 153 | 154 | Contents\MacOS 155 | 1 156 | 157 | 158 | 0 159 | 160 | 161 | 162 | 163 | res\xml 164 | 1 165 | 166 | 167 | res\xml 168 | 1 169 | 170 | 171 | 172 | 173 | library\lib\armeabi 174 | 1 175 | 176 | 177 | library\lib\armeabi 178 | 1 179 | 180 | 181 | 182 | 183 | library\lib\armeabi-v7a 184 | 1 185 | 186 | 187 | 188 | 189 | library\lib\mips 190 | 1 191 | 192 | 193 | library\lib\mips 194 | 1 195 | 196 | 197 | 198 | 199 | library\lib\armeabi-v7a 200 | 1 201 | 202 | 203 | library\lib\arm64-v8a 204 | 1 205 | 206 | 207 | 208 | 209 | library\lib\armeabi-v7a 210 | 1 211 | 212 | 213 | 214 | 215 | res\drawable 216 | 1 217 | 218 | 219 | res\drawable 220 | 1 221 | 222 | 223 | 224 | 225 | res\drawable-anydpi-v21 226 | 1 227 | 228 | 229 | res\drawable-anydpi-v21 230 | 1 231 | 232 | 233 | 234 | 235 | res\values 236 | 1 237 | 238 | 239 | res\values 240 | 1 241 | 242 | 243 | 244 | 245 | res\values-v21 246 | 1 247 | 248 | 249 | res\values-v21 250 | 1 251 | 252 | 253 | 254 | 255 | res\values-v31 256 | 1 257 | 258 | 259 | res\values-v31 260 | 1 261 | 262 | 263 | 264 | 265 | res\values-v35 266 | 1 267 | 268 | 269 | res\values-v35 270 | 1 271 | 272 | 273 | 274 | 275 | res\drawable-anydpi-v26 276 | 1 277 | 278 | 279 | res\drawable-anydpi-v26 280 | 1 281 | 282 | 283 | 284 | 285 | res\drawable 286 | 1 287 | 288 | 289 | res\drawable 290 | 1 291 | 292 | 293 | 294 | 295 | res\drawable 296 | 1 297 | 298 | 299 | res\drawable 300 | 1 301 | 302 | 303 | 304 | 305 | res\drawable 306 | 1 307 | 308 | 309 | res\drawable 310 | 1 311 | 312 | 313 | 314 | 315 | res\drawable-anydpi-v33 316 | 1 317 | 318 | 319 | res\drawable-anydpi-v33 320 | 1 321 | 322 | 323 | 324 | 325 | res\values 326 | 1 327 | 328 | 329 | res\values 330 | 1 331 | 332 | 333 | 334 | 335 | res\values-night-v21 336 | 1 337 | 338 | 339 | res\values-night-v21 340 | 1 341 | 342 | 343 | 344 | 345 | res\drawable 346 | 1 347 | 348 | 349 | res\drawable 350 | 1 351 | 352 | 353 | 354 | 355 | res\drawable-xxhdpi 356 | 1 357 | 358 | 359 | res\drawable-xxhdpi 360 | 1 361 | 362 | 363 | 364 | 365 | res\drawable-xxxhdpi 366 | 1 367 | 368 | 369 | res\drawable-xxxhdpi 370 | 1 371 | 372 | 373 | 374 | 375 | res\drawable-ldpi 376 | 1 377 | 378 | 379 | res\drawable-ldpi 380 | 1 381 | 382 | 383 | 384 | 385 | res\drawable-mdpi 386 | 1 387 | 388 | 389 | res\drawable-mdpi 390 | 1 391 | 392 | 393 | 394 | 395 | res\drawable-hdpi 396 | 1 397 | 398 | 399 | res\drawable-hdpi 400 | 1 401 | 402 | 403 | 404 | 405 | res\drawable-xhdpi 406 | 1 407 | 408 | 409 | res\drawable-xhdpi 410 | 1 411 | 412 | 413 | 414 | 415 | res\drawable-mdpi 416 | 1 417 | 418 | 419 | res\drawable-mdpi 420 | 1 421 | 422 | 423 | 424 | 425 | res\drawable-hdpi 426 | 1 427 | 428 | 429 | res\drawable-hdpi 430 | 1 431 | 432 | 433 | 434 | 435 | res\drawable-xhdpi 436 | 1 437 | 438 | 439 | res\drawable-xhdpi 440 | 1 441 | 442 | 443 | 444 | 445 | res\drawable-xxhdpi 446 | 1 447 | 448 | 449 | res\drawable-xxhdpi 450 | 1 451 | 452 | 453 | 454 | 455 | res\drawable-xxxhdpi 456 | 1 457 | 458 | 459 | res\drawable-xxxhdpi 460 | 1 461 | 462 | 463 | 464 | 465 | res\drawable-small 466 | 1 467 | 468 | 469 | res\drawable-small 470 | 1 471 | 472 | 473 | 474 | 475 | res\drawable-normal 476 | 1 477 | 478 | 479 | res\drawable-normal 480 | 1 481 | 482 | 483 | 484 | 485 | res\drawable-large 486 | 1 487 | 488 | 489 | res\drawable-large 490 | 1 491 | 492 | 493 | 494 | 495 | res\drawable-xlarge 496 | 1 497 | 498 | 499 | res\drawable-xlarge 500 | 1 501 | 502 | 503 | 504 | 505 | res\values 506 | 1 507 | 508 | 509 | res\values 510 | 1 511 | 512 | 513 | 514 | 515 | res\drawable-anydpi-v24 516 | 1 517 | 518 | 519 | res\drawable-anydpi-v24 520 | 1 521 | 522 | 523 | 524 | 525 | res\drawable 526 | 1 527 | 528 | 529 | res\drawable 530 | 1 531 | 532 | 533 | 534 | 535 | res\drawable-night-anydpi-v21 536 | 1 537 | 538 | 539 | res\drawable-night-anydpi-v21 540 | 1 541 | 542 | 543 | 544 | 545 | res\drawable-anydpi-v31 546 | 1 547 | 548 | 549 | res\drawable-anydpi-v31 550 | 1 551 | 552 | 553 | 554 | 555 | res\drawable-night-anydpi-v31 556 | 1 557 | 558 | 559 | res\drawable-night-anydpi-v31 560 | 1 561 | 562 | 563 | 564 | 565 | 1 566 | 567 | 568 | Contents\MacOS 569 | 1 570 | 571 | 572 | 0 573 | 574 | 575 | 576 | 577 | Contents\MacOS 578 | 1 579 | .framework 580 | 581 | 582 | Contents\MacOS 583 | 1 584 | .framework 585 | 586 | 587 | Contents\MacOS 588 | 1 589 | .framework 590 | 591 | 592 | 0 593 | 594 | 595 | 596 | 597 | 1 598 | .dylib 599 | 600 | 601 | 1 602 | .dylib 603 | 604 | 605 | 1 606 | .dylib 607 | 608 | 609 | Contents\MacOS 610 | 1 611 | .dylib 612 | 613 | 614 | Contents\MacOS 615 | 1 616 | .dylib 617 | 618 | 619 | Contents\MacOS 620 | 1 621 | .dylib 622 | 623 | 624 | 0 625 | .dll;.bpl 626 | 627 | 628 | 629 | 630 | 1 631 | .dylib 632 | 633 | 634 | 1 635 | .dylib 636 | 637 | 638 | 1 639 | .dylib 640 | 641 | 642 | Contents\MacOS 643 | 1 644 | .dylib 645 | 646 | 647 | Contents\MacOS 648 | 1 649 | .dylib 650 | 651 | 652 | Contents\MacOS 653 | 1 654 | .dylib 655 | 656 | 657 | 0 658 | .bpl 659 | 660 | 661 | 662 | 663 | 0 664 | 665 | 666 | 0 667 | 668 | 669 | 0 670 | 671 | 672 | 0 673 | 674 | 675 | 0 676 | 677 | 678 | Contents\Resources\StartUp\ 679 | 0 680 | 681 | 682 | Contents\Resources\StartUp\ 683 | 0 684 | 685 | 686 | Contents\Resources\StartUp\ 687 | 0 688 | 689 | 690 | 0 691 | 692 | 693 | 694 | 695 | 1 696 | 697 | 698 | 1 699 | 700 | 701 | 702 | 703 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 704 | 1 705 | 706 | 707 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 708 | 1 709 | 710 | 711 | 712 | 713 | ..\ 714 | 1 715 | 716 | 717 | ..\ 718 | 1 719 | 720 | 721 | ..\ 722 | 1 723 | 724 | 725 | 726 | 727 | Contents 728 | 1 729 | 730 | 731 | Contents 732 | 1 733 | 734 | 735 | Contents 736 | 1 737 | 738 | 739 | 740 | 741 | Contents\Resources 742 | 1 743 | 744 | 745 | Contents\Resources 746 | 1 747 | 748 | 749 | Contents\Resources 750 | 1 751 | 752 | 753 | 754 | 755 | library\lib\armeabi-v7a 756 | 1 757 | 758 | 759 | library\lib\arm64-v8a 760 | 1 761 | 762 | 763 | 1 764 | 765 | 766 | 1 767 | 768 | 769 | 1 770 | 771 | 772 | 1 773 | 774 | 775 | Contents\MacOS 776 | 1 777 | 778 | 779 | Contents\MacOS 780 | 1 781 | 782 | 783 | Contents\MacOS 784 | 1 785 | 786 | 787 | 0 788 | 789 | 790 | 791 | 792 | library\lib\armeabi-v7a 793 | 1 794 | 795 | 796 | 797 | 798 | 1 799 | 800 | 801 | 1 802 | 803 | 804 | 1 805 | 806 | 807 | 808 | 809 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 810 | 1 811 | 812 | 813 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 814 | 1 815 | 816 | 817 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 818 | 1 819 | 820 | 821 | 822 | 823 | ..\ 824 | 1 825 | 826 | 827 | ..\ 828 | 1 829 | 830 | 831 | ..\ 832 | 1 833 | 834 | 835 | 836 | 837 | 1 838 | 839 | 840 | 1 841 | 842 | 843 | 1 844 | 845 | 846 | 847 | 848 | ..\$(PROJECTNAME).launchscreen 849 | 64 850 | 851 | 852 | ..\$(PROJECTNAME).launchscreen 853 | 64 854 | 855 | 856 | 857 | 858 | 1 859 | 860 | 861 | 1 862 | 863 | 864 | 1 865 | 866 | 867 | 868 | 869 | Assets 870 | 1 871 | 872 | 873 | Assets 874 | 1 875 | 876 | 877 | 878 | 879 | Assets 880 | 1 881 | 882 | 883 | Assets 884 | 1 885 | 886 | 887 | 888 | 889 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 890 | 1 891 | 892 | 893 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 894 | 1 895 | 896 | 897 | 898 | 899 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 900 | 1 901 | 902 | 903 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 904 | 1 905 | 906 | 907 | 908 | 909 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 910 | 1 911 | 912 | 913 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 914 | 1 915 | 916 | 917 | 918 | 919 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 920 | 1 921 | 922 | 923 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 924 | 1 925 | 926 | 927 | 928 | 929 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 930 | 1 931 | 932 | 933 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 934 | 1 935 | 936 | 937 | 938 | 939 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 940 | 1 941 | 942 | 943 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 944 | 1 945 | 946 | 947 | 948 | 949 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 950 | 1 951 | 952 | 953 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 954 | 1 955 | 956 | 957 | 958 | 959 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 960 | 1 961 | 962 | 963 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 964 | 1 965 | 966 | 967 | 968 | 969 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 970 | 1 971 | 972 | 973 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 974 | 1 975 | 976 | 977 | 978 | 979 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 980 | 1 981 | 982 | 983 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 984 | 1 985 | 986 | 987 | 988 | 989 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 990 | 1 991 | 992 | 993 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 994 | 1 995 | 996 | 997 | 998 | 999 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1000 | 1 1001 | 1002 | 1003 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1004 | 1 1005 | 1006 | 1007 | 1008 | 1009 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1010 | 1 1011 | 1012 | 1013 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1014 | 1 1015 | 1016 | 1017 | 1018 | 1019 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1020 | 1 1021 | 1022 | 1023 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1024 | 1 1025 | 1026 | 1027 | 1028 | 1029 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1030 | 1 1031 | 1032 | 1033 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1034 | 1 1035 | 1036 | 1037 | 1038 | 1039 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1040 | 1 1041 | 1042 | 1043 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1044 | 1 1045 | 1046 | 1047 | 1048 | 1049 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1050 | 1 1051 | 1052 | 1053 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1054 | 1 1055 | 1056 | 1057 | 1058 | 1059 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1060 | 1 1061 | 1062 | 1063 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1064 | 1 1065 | 1066 | 1067 | 1068 | 1069 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1070 | 1 1071 | 1072 | 1073 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1074 | 1 1075 | 1076 | 1077 | 1078 | 1079 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1080 | 1 1081 | 1082 | 1083 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1084 | 1 1085 | 1086 | 1087 | 1088 | 1089 | 1090 | 1091 | 1092 | 1093 | 1094 | 1095 | 1096 | 1097 | 1098 | 1099 | 1100 | 1101 | 12 1102 | 1103 | 1104 | 1105 | 1106 | 1107 | -------------------------------------------------------------------------------- /Demos/FirebirdService/FirbirdService.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TommiPrami/DelphiServiceManager/b4799d6ba9e3286934a28dca86052cf49653e204/Demos/FirebirdService/FirbirdService.res -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Tommi Prami 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DelphiServiceManager 2 | 3 | Service manager classes by Gurus Ritsaert Hornstra and Darian Miller. I (Tommi Prami) did some tweaking and refactoring. Slapped on premissive MIT licence if no objections (Original didn't have any). 4 | 5 | -------------------------------------------------------------------------------- /Windows.ServiceManager.Consts.pas: -------------------------------------------------------------------------------- 1 | unit Windows.ServiceManager.Consts; 2 | 3 | interface 4 | 5 | uses 6 | Windows.ServiceManager.Types; 7 | 8 | const 9 | // OS Error 10 | LAST_OS_ERROR = -1; 11 | // Rest of the error codes 12 | SERVICELIST_NOT_ACTIVE = 1; 13 | SERVICE_NOT_FOUND = 2; 14 | OS_NOT_CUPPOORTED = 3; 15 | IS_ACTIVE = 4; 16 | LOCKING_NOT_ALLOWED = 5; 17 | OPERATION_NOT_ALLOWED_WHILE_ACTIVE = 6; 18 | SERVICE_STATE_UNKNOWN = 7; 19 | SERVICE_CANNOT_CONTINUE = 8; 20 | SERVICE_CANNOT_PAUSE = 9; 21 | SERVICE_CANNOT_STOP = 10; 22 | SERVICE_TIMEOUT = 11; 23 | SERVICE_STARTTYPE_UNKNOWN = 12; 24 | SERVICE_CANNOT_SET_STATE = 13; 25 | SERVICE_ACCESS_DIFFERS = 14; 26 | 27 | ErrorInfoArray: array[0..13] of TErrorInfo = 28 | ( 29 | (ErrorCode: SERVICELIST_NOT_ACTIVE; ExceptionClass: ENotActive; ErrorMessage: 'BuildServicesList only works when Active.'), 30 | (ErrorCode: SERVICE_NOT_FOUND; ExceptionClass: EServiceNotFound; ErrorMessage: 'Service not found.'), 31 | (ErrorCode: OS_NOT_CUPPOORTED; ExceptionClass: EOSNotSupported; ErrorMessage: 'This program only works on Windows NT, 2000, XP or later.'), 32 | (ErrorCode: IS_ACTIVE; ExceptionClass: EOperationNotAllowedWhileActive; ErrorMessage: 'Cannot change machine name while Active.'), 33 | (ErrorCode: LOCKING_NOT_ALLOWED; ExceptionClass: ELockingNotAllowed; ErrorMessage: 'Locking of the service manager not allowed.'), 34 | (ErrorCode: OPERATION_NOT_ALLOWED_WHILE_ACTIVE; ExceptionClass: EOperationNotAllowedWhileActive; ErrorMessage: 'Cannot change allow locking while active.'), 35 | (ErrorCode: SERVICE_STATE_UNKNOWN; ExceptionClass: EServiceStateUnknown; ErrorMessage: 'Service State unknown.'), 36 | (ErrorCode: SERVICE_CANNOT_CONTINUE; ExceptionClass: EServiceCannotBeContinued; ErrorMessage: 'Service cannot be continued.'), 37 | (ErrorCode: SERVICE_CANNOT_PAUSE; ExceptionClass: EServiceCannotBeContinued; ErrorMessage: 'Service cannot be paused.'), 38 | (ErrorCode: SERVICE_CANNOT_STOP; ExceptionClass: EServiceCannotBeStopped; ErrorMessage: 'Service cannot be Stopped.'), 39 | (ErrorCode: SERVICE_TIMEOUT; ExceptionClass: EServiceDidNotRespond; ErrorMessage: 'Service did not react within timeframe given.'), 40 | (ErrorCode: SERVICE_STARTTYPE_UNKNOWN; ExceptionClass: EServiceServiceStartTypeUnknown; ErrorMessage: 'Service Start Type unknown.'), 41 | (ErrorCode: SERVICE_CANNOT_SET_STATE; ExceptionClass: ECannotSetTransitionalState; ErrorMessage: 'Cannot set a transitional state.'), 42 | (ErrorCode: SERVICE_ACCESS_DIFFERS; ExceptionClass: EServiceAccessDiffers; ErrorMessage: 'Service access differs.') 43 | ); 44 | 45 | implementation 46 | 47 | end. 48 | -------------------------------------------------------------------------------- /Windows.ServiceManager.Types.pas: -------------------------------------------------------------------------------- 1 | unit Windows.ServiceManager.Types; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | type 9 | ECustomServiceManagerException = class(Exception); 10 | 11 | ENotActive = class(ECustomServiceManagerException); 12 | EServiceNotFound = class(ECustomServiceManagerException); 13 | EOSNotSupported = class(ECustomServiceManagerException); 14 | EOperationNotAllowedWhileActive = class(ECustomServiceManagerException); 15 | ELockingNotAllowed = class(ECustomServiceManagerException); 16 | EServiceStateUnknown = class(ECustomServiceManagerException); 17 | EServiceCannotBeContinued = class(ECustomServiceManagerException); 18 | EServiceCannotBePaused = class(ECustomServiceManagerException); 19 | EServiceCannotBeStopped = class(ECustomServiceManagerException); 20 | EServiceDidNotRespond = class(ECustomServiceManagerException); 21 | EServiceServiceStartTypeUnknown = class(ECustomServiceManagerException); 22 | ECannotSetTransitionalState = class(ECustomServiceManagerException); 23 | EServiceAccessDiffers = class(ECustomServiceManagerException); 24 | 25 | TErrorInfo = record 26 | ErrorCode: Integer; 27 | ExceptionClass: ExceptClass; 28 | ErrorMessage: string; 29 | end; 30 | 31 | { The states a service can be in. } 32 | TServiceState = (ssStopped, 33 | ssStartPending, 34 | ssStopPending, 35 | ssRunning, 36 | ssContinuePending, 37 | ssPausePending, 38 | ssPaused); 39 | 40 | { Enumeration of the standard "controls" a service can accept. The shutdown control, if not 41 | accepted is ignored. The shutdown control can only be sent when a shutdown occurs. } 42 | TServiceAccept = (saStop, 43 | saPauseContinue, 44 | saShutdown); 45 | 46 | { The set of "controls" a service can accept. } 47 | TServiceAccepts = set of TServiceAccept; 48 | 49 | { The service startup enumeration determines how a service is started. ssAutomatic will start the 50 | service automatically at startup. ssManual will allow applications and other services to start 51 | this service manually and ssDisabled will disallow the service to be started altogether (but it 52 | will be kept in the service database). } 53 | TServiceStartup = (ssAutomatic, 54 | ssManual, 55 | ssDisabled); 56 | 57 | 58 | implementation 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /Windows.ServiceManager.pas: -------------------------------------------------------------------------------- 1 | unit Windows.ServiceManager; 2 | 3 | { --------------------------------------------------------------------------- } 4 | { } 5 | { Written with } 6 | { - Delphi XE3 Pro } 7 | { - Refactored with 11.2 } 8 | { } 9 | { Created Nov 24, 2012 by Darian Miller } 10 | { - Some refactoring etc by Tommi Prami } 11 | { } 12 | { Based on answer by Ritsaert Hornstra on May 6, 2011 to question: } 13 | { - http://stackoverflow.com/questions/5913279/detect-windows-service-state } 14 | { - https://stackoverflow.com/users/246383/ritsaert-hornstra (Thanks man) } 15 | { } 16 | { --------------------------------------------------------------------------- } 17 | 18 | interface 19 | 20 | uses 21 | Winapi.Windows, Winapi.Winsvc, System.Generics.Collections, System.SysUtils, Windows.ServiceManager.Types; 22 | 23 | type 24 | // Forward declaration of Service manager class 25 | TServiceManager = class; 26 | 27 | { Gives information of and controls a single Service. Can be accessed via @link(TServiceManager). } 28 | TServiceInfo = class(TObject) 29 | private 30 | FBinaryPathName: string; 31 | FCommandLine: string; 32 | FConfigQueried: Boolean; 33 | FDisplayName: string; 34 | FFileName: string; 35 | FIndex: Integer; 36 | FInteractive: Boolean; 37 | FLive: Boolean; 38 | FOwnProcess: Boolean; 39 | FPath: string; 40 | FServiceHandle: SC_HANDLE; 41 | FServiceHandleAccess: DWORD; 42 | FServiceManager: TServiceManager; 43 | FServiceName: string; 44 | FServiceStatus: TServiceStatus; 45 | FStartType: TServiceStartup; 46 | FUserName: string; 47 | function DependenciesToList(const AQServicesStatus: PEnumServiceStatus; const AServiceInfoCount: Integer): TArray; 48 | function GetBinaryPathname: string; 49 | function GetCommandLine: string; 50 | function GetFileName: string; 51 | function GetHandle(const AAccess: DWORD): Boolean; 52 | function GetInteractive: Boolean; 53 | function GetOwnProcess: Boolean; 54 | function GetPath: string; 55 | function GetServiceAccepts: TServiceAccepts; 56 | function GetServiceStartType(const AServiceConfig: QUERY_SERVICE_CONFIG; var AStartType: TServiceStartup): Boolean; 57 | function GetStartType: TServiceStartup; 58 | function GetState: TServiceState; 59 | function HandleOK: Boolean; 60 | function Query: Boolean; 61 | function QueryConfig: Boolean; 62 | function WaitFor(const AState: DWORD): Boolean; 63 | function WaitForPendingServiceState(const AServiceState: TServiceState): Boolean; 64 | procedure CleanupHandle; 65 | procedure ParseBinaryPath; 66 | procedure RefreshIfNeeded; 67 | procedure SetStartType(const AValue: TServiceStartup); 68 | procedure SetState(const AServiceState: TServiceState); 69 | protected 70 | function InitializeByName(const AServiceName: string): Boolean; 71 | public 72 | constructor Create(const AParentServiceManager: TServiceManager); 73 | destructor Destroy; override; 74 | 75 | { Get array of services that depent on this service } 76 | function Dependents: TArray; 77 | { Action: Pause a running service. } 78 | function Pause(const AWait: Boolean = True): Boolean; 79 | { Action: Continue a paused service. } 80 | function Continue(const AWait: Boolean = True): Boolean; 81 | { Action: Stop a running service. } 82 | function Stop(const AWait: Boolean = True): Boolean; 83 | { Action: Start a not running service. 84 | You can use the @link(State) property to change the state from ssStopped to ssRunning } 85 | function Start(const AWait: Boolean = True): Boolean; 86 | { Name of this service. } 87 | property Name: string read FServiceName; 88 | { Display name of this service } 89 | property DisplayName: string read FDisplayName; 90 | { The current state of the service. You can set the service only to the non-transitional states. 91 | You can restart the service by first setting the State to first ssStopped and second ssRunning. } 92 | property State: TServiceState read GetState write SetState; 93 | { Are various properties using live information or historic information. } 94 | property Live: Boolean read FLive write FLive; 95 | { When service is running, does it run as a separate process (own process) or combined with 96 | other services under svchost. } 97 | property OwnProcess: Boolean read GetOwnProcess; 98 | { Is the service capable of interacting with the desktop. 99 | Possible: The logon must the Local System Account. } 100 | property Interactive: Boolean read GetInteractive; 101 | { How is this service started. See @link(TServiceStartup) for a description of startup types. 102 | If you want to set this property, the manager must be activeted with AllowLocking set to True. } 103 | property StartType: TServiceStartup read GetStartType write SetStartType; 104 | { Path to the binary that implements the service. } 105 | property BinaryPathName: string read GetBinaryPathName; 106 | property Path: string read GetPath; 107 | property FileName: string read GetFileName; 108 | property CommandLine: string read GetCommandLine; 109 | { See what controls the service accepts. } 110 | property ServiceAccepts: TServiceAccepts read GetServiceAccepts; 111 | { Index in ServiceManagers list } 112 | property Index: Integer read FIndex write FIndex; 113 | { } 114 | property UserName: string read FUserName; 115 | end; 116 | 117 | { A service manager allows the services of a particular machine to be explored and modified. } 118 | TServiceManager = class(TObject) 119 | strict private 120 | FAllowLocking: Boolean; 121 | FGetServiceListOnActive: Boolean; 122 | FLastErrorCode: Integer; 123 | FLastErrorMessage: string; 124 | FLastSystemErrorCode: DWord; 125 | FLastSystemErrorMessage: string; 126 | FLockHandle: SC_LOCK; 127 | FHostName: string; 128 | FManagerHandle: SC_HANDLE; 129 | FRaiseExceptions: Boolean; 130 | FServicesByName: TDictionary; 131 | FServicesList: TObjectList; 132 | function CheckOS: Boolean; 133 | function GetActive: Boolean; 134 | function GetService(const AIndex: Integer): TServiceInfo; 135 | function GetServiceCount: Integer; 136 | function InitializeSingleService(const AServiceName: string): TServiceInfo; 137 | procedure AddServiceInfoToLists(const AServiceInfo: TServiceInfo); 138 | procedure CleanupServices; 139 | procedure EnumerateAndAddServices(const AServices: PEnumServiceStatus; const AByesNeeded: DWORD); 140 | procedure ServiceToLists(const AServiceEnumStatus: ENUM_SERVICE_STATUS); 141 | procedure SetActive(const ASetToActive: Boolean); 142 | procedure SetAllowLocking(const AValue: Boolean); 143 | procedure SetHostName(const AHostName: string); 144 | private 145 | function GetError: Boolean; 146 | function GetErrorMessage: string; 147 | protected 148 | { using classic protected visibility to give TServiceInfo access to TServiceManager services that nare not public } 149 | function GetManagerHandle: SC_HANDLE; 150 | function Lock: Boolean; 151 | function Unlock: Boolean; 152 | procedure HandleError(const AErrorCode: Integer; const AForceException: Boolean = False); 153 | procedure ResetLastError; 154 | procedure SortArray(var AServiceInfoArray: TArray); 155 | public 156 | constructor Create(const AHostName: string = ''; const AGetServiceListOnActive: Boolean = True; 157 | const ARaiseExceptions: Boolean = True; const AAllowLocking: Boolean = False); 158 | destructor Destroy; override; 159 | 160 | // Begin- and EndLockingProcess, so can easily do propcess between try..finally, which need locking 161 | procedure BeginLockingProcess(const AActivateServiceManager: Boolean = True); 162 | procedure EndLockingProcess; 163 | // 164 | function Open: Boolean; 165 | function Close: Boolean; 166 | { Requeries the states, names etc of all services on the given @link(HostName). 167 | Works only while active. } 168 | function RebuildServicesList: Boolean; 169 | { Find services by name (case insensitive). Works only while active. If no service can be found 170 | an exception will be raised. } 171 | function ServiceByName(const AServiceName: string; const AAllowUnknown: Boolean = False): TServiceInfo; 172 | { Get array of services, sorted by display name, Serrvice manager owns objects, so handle with care. } 173 | function GetServicesByDisplayName: TArray; 174 | { Delete a service... } 175 | // procedure DeleteService(Index: Integer); 176 | { Get the number of services. This number is refreshed when the @link(Active) is 177 | set to True or @link(RebuildServicesList) is called. Works only while active. } 178 | property ServiceCount: Integer read GetServiceCount; 179 | { Find a service by index in the services list. This list is refreshed when the @link(Active) is 180 | set to True or @link(RebuildServicesList) is called. Works only while active. Valid Index 181 | values are 0..@link(ServiceCount) - 1. } 182 | property Services[const AIndex: Integer]: TServiceInfo read GetService; 183 | { Activate / deactivate the service manager. In active state can you access the individual 184 | service, check RaiseExceptions property and open and close methods, thiose will affect on how this property 185 | works } 186 | property Active: Boolean read GetActive write SetActive; 187 | { The machine name for which you want the services list. } 188 | property HostName: string read FHostName write SetHostName; 189 | { Allow locking... Is needed only when changing several properties in TServiceInfo. 190 | Property can only be set while inactive. } 191 | property AllowLocking: Boolean read FAllowLocking write SetAllowLocking; 192 | { Raise Exceptions, if all functions should return False if it fails, then more info at Last*Error* properties} 193 | property RaiseExceptions: Boolean read FRaiseExceptions write FRaiseExceptions; 194 | // Error properties, check HandleError() 195 | property Error: Boolean read GetError; 196 | property ErrorMessage: string read GetErrorMessage; 197 | property LastErrorCode: Integer read FLastErrorCode; 198 | property LastSystemErrorCode: DWord read FLastSystemErrorCode; 199 | property LastSystemErrorMessage: string read FLastSystemErrorMessage; 200 | property LastErrorMessage: string read FLastErrorMessage; 201 | property GetServiceListOnActive: Boolean read FGetServiceListOnActive write FGetServiceListOnActive; 202 | end; 203 | 204 | function ServiceStateToString(const AServiceState: TServiceState): string; 205 | 206 | implementation 207 | 208 | uses 209 | System.Generics.Defaults, System.SysConst, Windows.ServiceManager.Consts; 210 | 211 | function ServiceStateToString(const AServiceState: TServiceState): string; 212 | begin 213 | // TODO: Should make this easier to localize, if needed. 214 | case AServiceState of 215 | ssStopped: Result := 'Stopped'; 216 | ssStartPending: Result := 'Starting...'; 217 | ssStopPending: Result := 'Stopping...'; 218 | ssRunning: Result := 'Running'; 219 | ssContinuePending: Result := 'Continuing...'; 220 | ssPausePending: Result := 'Pausing...'; 221 | ssPaused: Result := 'Paused'; 222 | end; 223 | end; 224 | 225 | { TServiceManager } 226 | 227 | function TServiceManager.RebuildServicesList: Boolean; 228 | var 229 | LServices: PEnumServiceStatus; 230 | LBytesNeeded: DWORD; 231 | LServicesReturned: DWORD; 232 | LResumeHandle: DWORD; 233 | begin 234 | Result := False; 235 | 236 | if not Active then 237 | begin 238 | HandleError(SERVICELIST_NOT_ACTIVE); 239 | Exit; 240 | end; 241 | 242 | // Cleanup 243 | ResetLastError; 244 | CleanupServices; 245 | 246 | LServicesReturned := 0; 247 | LResumeHandle := 0; 248 | LServices := nil; 249 | 250 | // Get the amount of memory needed... 251 | if EnumServicesStatus(FManagerHandle, SERVICE_WIN32, SERVICE_STATE_ALL, LServices, 0, LBytesNeeded, LServicesReturned, 252 | LResumeHandle) then 253 | Exit; 254 | 255 | if GetLastError <> ERROR_MORE_DATA then 256 | begin 257 | HandleError(LAST_OS_ERROR); 258 | Exit; 259 | end; 260 | 261 | GetMem(LServices, LBytesNeeded); // will raise EOutOfMemory if fails 262 | try 263 | EnumerateAndAddServices(LServices, LBytesNeeded); 264 | finally 265 | FreeMem(LServices); 266 | end; 267 | 268 | Result := True; 269 | end; 270 | 271 | procedure TServiceManager.ResetLastError; 272 | begin 273 | FLastErrorCode := 0; 274 | FLastSystemErrorCode := 0; 275 | FLastErrorMessage := ''; 276 | FLastSystemErrorMessage := ''; 277 | end; 278 | 279 | procedure TServiceManager.AddServiceInfoToLists(const AServiceInfo: TServiceInfo); 280 | begin 281 | AServiceInfo.FIndex := FServicesList.Add(AServiceInfo); 282 | FServicesByName.Add(AServiceInfo.FServiceName.ToLower, AServiceInfo); 283 | end; 284 | 285 | procedure TServiceManager.BeginLockingProcess(const AActivateServiceManager: Boolean = True); 286 | begin 287 | AllowLocking := True; 288 | 289 | if not Active and AActivateServiceManager then 290 | Active := True; 291 | end; 292 | 293 | function TServiceManager.CheckOS: Boolean; 294 | var 295 | LVersionInfo: TOSVersionInfo; 296 | begin 297 | Result := False; 298 | // Check that we are NT, 2000, XP or above... 299 | LVersionInfo.dwOSVersionInfoSize := SizeOf(LVersionInfo); 300 | 301 | if not GetVersionEx(LVersionInfo) then 302 | begin 303 | HandleError(LAST_OS_ERROR); 304 | Exit; 305 | end; 306 | 307 | if LVersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_NT then 308 | begin 309 | HandleError(OS_NOT_CUPPOORTED); 310 | Exit; 311 | end; 312 | 313 | Result := True; 314 | end; 315 | 316 | procedure TServiceManager.CleanupServices; 317 | begin 318 | FServicesList.Clear; 319 | FServicesByName.Clear; 320 | end; 321 | 322 | function TServiceManager.Close: Boolean; 323 | begin 324 | if not Active then 325 | Exit(True); 326 | 327 | Result := False; 328 | 329 | ResetLastError; 330 | CleanupServices; 331 | 332 | if Assigned(FLockHandle) then 333 | if not Unlock then 334 | Exit; 335 | 336 | CloseServiceHandle(FManagerHandle); 337 | FManagerHandle := 0; 338 | 339 | Result := not GetActive; 340 | end; 341 | 342 | constructor TServiceManager.Create(const AHostName: string = ''; const AGetServiceListOnActive: Boolean = True; 343 | const ARaiseExceptions: Boolean = True; const AAllowLocking: Boolean = False); 344 | begin 345 | inherited Create; 346 | 347 | FServicesList := TObjectList.Create(True); 348 | FServicesByName := TDictionary.Create; 349 | ResetLastError; 350 | FManagerHandle := 0; 351 | FHostName := AHostName; 352 | FRaiseExceptions := ARaiseExceptions; 353 | FGetServiceListOnActive := AGetServiceListOnActive; 354 | FAllowLocking := AAllowLocking; 355 | end; 356 | 357 | destructor TServiceManager.Destroy; 358 | begin 359 | Active := False; 360 | 361 | FServicesList.Free; 362 | FServicesByName.Free; 363 | 364 | inherited Destroy; 365 | end; 366 | 367 | procedure TServiceManager.EndLockingProcess; 368 | begin 369 | if Active then 370 | Active := False; 371 | 372 | AllowLocking := False; 373 | end; 374 | 375 | procedure TServiceManager.EnumerateAndAddServices(const AServices: PEnumServiceStatus; const AByesNeeded: DWORD); 376 | var 377 | LIndex: DWORD; 378 | LServicesLoopPointer: PEnumServiceStatus; 379 | LServicesReturned: DWORD; 380 | LResumeHandle: DWORD; 381 | LBytesNeeded: DWORD; 382 | begin 383 | LServicesReturned := 0; 384 | LResumeHandle := 0; 385 | LBytesNeeded := AByesNeeded; 386 | 387 | if not EnumServicesStatus(FManagerHandle, SERVICE_WIN32, SERVICE_STATE_ALL, AServices, LBytesNeeded, LBytesNeeded, 388 | LServicesReturned, LResumeHandle) then 389 | Exit; 390 | 391 | LServicesLoopPointer := AServices; 392 | LIndex := 0; 393 | while LIndex <= LServicesReturned - 1 do 394 | begin 395 | ServiceToLists(LServicesLoopPointer^); 396 | 397 | Inc(LServicesLoopPointer); 398 | Inc(LIndex); 399 | end; 400 | end; 401 | 402 | function TServiceManager.GetActive: Boolean; 403 | begin 404 | Result := FManagerHandle <> 0; 405 | end; 406 | 407 | function TServiceManager.GetError: Boolean; 408 | begin 409 | Result := (FLastErrorCode <> 0) or (FLastSystemErrorCode <> 0); 410 | end; 411 | 412 | function TServiceManager.GetErrorMessage: string; 413 | begin 414 | Result := ''; 415 | 416 | if FLastErrorCode <> 0 then 417 | Result := Format('Error (%d) with message:', [FLastErrorCode, FLastErrorMessage]) 418 | else if FLastSystemErrorCode <> 0 then 419 | Result := Format('System error (%d) with message:', [FLastSystemErrorCode, FLastSystemErrorMessage]); 420 | end; 421 | 422 | function TServiceManager.GetManagerHandle: SC_HANDLE; 423 | begin 424 | Result := FManagerHandle; 425 | end; 426 | 427 | function TServiceManager.GetService(const AIndex: Integer): TServiceInfo; 428 | begin 429 | Result := FServicesList[AIndex]; 430 | end; 431 | 432 | function TServiceManager.ServiceByName(const AServiceName: string; const AAllowUnknown: Boolean = False): TServiceInfo; 433 | begin 434 | if not FServicesByName.TryGetValue(AServiceName.ToLower, Result) then 435 | begin 436 | Result := nil; 437 | 438 | if not FGetServiceListOnActive then 439 | begin 440 | if not Active then 441 | begin 442 | HandleError(SERVICELIST_NOT_ACTIVE); 443 | Exit; 444 | end; 445 | 446 | Result := InitializeSingleService(AServiceName); 447 | if Assigned(Result) then 448 | AddServiceInfoToLists(Result); 449 | end; 450 | 451 | 452 | if not AAllowUnknown and not Assigned(Result) then 453 | HandleError(SERVICE_NOT_FOUND); 454 | end; 455 | end; 456 | 457 | function TServiceManager.GetServiceCount: Integer; 458 | begin 459 | Result := FServicesList.Count; 460 | end; 461 | 462 | function TServiceManager.GetServicesByDisplayName: TArray; 463 | begin 464 | Result := FServicesList.ToArray; 465 | 466 | SortArray(Result); 467 | end; 468 | 469 | procedure TServiceManager.HandleError(const AErrorCode: Integer; const AForceException: Boolean = False); 470 | var 471 | LErrorInfo: TErrorInfo; 472 | LOSError: EOSError; 473 | begin 474 | if AErrorCode = LAST_OS_ERROR then 475 | begin 476 | FLastSystemErrorCode := GetLastError; 477 | if FLastSystemErrorCode <> 0 then 478 | FLastSystemErrorMessage := SysErrorMessage(FLastSystemErrorCode) 479 | else 480 | FLastSystemErrorMessage := SUnkOSError; 481 | 482 | if FRaiseExceptions or AForceException then 483 | begin 484 | if FLastSystemErrorCode <> 0 then 485 | LOSError := EOSError.CreateResFmt(@SOSError, [FLastSystemErrorCode, FLastSystemErrorMessage, '']) 486 | else 487 | LOSError := EOSError.CreateRes(@SUnkOSError); 488 | 489 | LOSError.ErrorCode := FLastSystemErrorCode; 490 | 491 | raise LOSError at ReturnAddress; 492 | end; 493 | end 494 | else 495 | begin 496 | FLastErrorCode := AErrorCode; 497 | LErrorInfo := ErrorInfoArray[AErrorCode - 1]; 498 | 499 | FLastErrorMessage := LErrorInfo.ErrorMessage; 500 | 501 | if FRaiseExceptions or AForceException then 502 | raise LErrorInfo.ExceptionClass.Create(FLastErrorMessage) at ReturnAddress; 503 | end; 504 | end; 505 | 506 | function TServiceManager.InitializeSingleService(const AServiceName: string): TServiceInfo; 507 | begin 508 | Result := TServiceInfo.Create(Self); 509 | try 510 | if not Result.InitializeByName(AServiceName) then 511 | FreeAndNil(Result); 512 | except 513 | FreeAndNil(Result); 514 | end; 515 | end; 516 | 517 | procedure TServiceManager.ServiceToLists(const AServiceEnumStatus: ENUM_SERVICE_STATUS); 518 | var 519 | LServiceInfo: TServiceInfo; 520 | begin 521 | LServiceInfo := TServiceInfo.Create(Self); 522 | LServiceInfo.FServiceName := AServiceEnumStatus.lpServiceName; 523 | LServiceInfo.FDisplayName := AServiceEnumStatus.lpDisplayName; 524 | LServiceInfo.FServiceStatus := AServiceEnumStatus.ServiceStatus; 525 | 526 | AddServiceInfoToLists(LServiceInfo); 527 | end; 528 | 529 | procedure TServiceManager.SetActive(const ASetToActive: Boolean); 530 | begin 531 | if ASetToActive then 532 | Open 533 | else 534 | Close; 535 | end; 536 | 537 | procedure TServiceManager.SetHostName(const AHostName: string); 538 | begin 539 | if Active then 540 | begin 541 | HandleError(IS_ACTIVE); 542 | Exit; 543 | end; 544 | 545 | FHostName := AHostName; 546 | end; 547 | 548 | procedure TServiceManager.SortArray(var AServiceInfoArray: TArray); 549 | begin 550 | TArray.Sort(AServiceInfoArray, TDelegatedComparer.Construct( 551 | function(const ALeft, ARight:TServiceInfo): Integer 552 | begin 553 | Result := TComparer.Default.Compare(ALeft.DisplayName, ARight.DisplayName); 554 | end) 555 | ); 556 | end; 557 | 558 | (* 559 | procedure TServiceManager.DeleteService(Index: Integer); 560 | begin 561 | // todo: implementation 562 | raise Exception.Create('Not implemented'); 563 | end; 564 | *) 565 | 566 | function TServiceManager.Lock: Boolean; 567 | begin 568 | Result := False; 569 | 570 | if not FAllowLocking then 571 | begin 572 | HandleError(LOCKING_NOT_ALLOWED); 573 | Exit; 574 | end; 575 | 576 | ResetLastError; 577 | 578 | FLockHandle := LockServiceDatabase(FManagerHandle); 579 | 580 | if FLockHandle = nil then 581 | begin 582 | HandleError(LAST_OS_ERROR); 583 | Exit; 584 | end 585 | else 586 | Result := True; 587 | end; 588 | 589 | function TServiceManager.Open: Boolean; 590 | var 591 | LDesiredAccess: DWORD; 592 | begin 593 | if Active then 594 | Exit(True); 595 | 596 | Result := False; 597 | 598 | ResetLastError; 599 | if not CheckOS then 600 | Exit; 601 | 602 | // Open service manager 603 | LDesiredAccess := SC_MANAGER_CONNECT or SC_MANAGER_ENUMERATE_SERVICE; 604 | if FAllowLocking then 605 | Inc(LDesiredAccess, SC_MANAGER_LOCK); 606 | 607 | FManagerHandle := OpenSCManager(PChar(FHostName), nil, LDesiredAccess); 608 | if not Active then 609 | begin 610 | HandleError(LAST_OS_ERROR); 611 | Exit; 612 | end; 613 | 614 | // Fetch the srvices list 615 | Result := GetActive; 616 | if Result and FGetServiceListOnActive then 617 | Result := RebuildServicesList; 618 | end; 619 | 620 | function TServiceManager.Unlock: Boolean; 621 | begin 622 | // We are unlocked already 623 | if FLockHandle = nil then 624 | Exit(True); 625 | 626 | Result := False; 627 | ResetLastError; 628 | // Unlock... 629 | if not UnlockServiceDatabase(FLockHandle) then 630 | begin 631 | HandleError(LAST_OS_ERROR); 632 | Exit; 633 | end; 634 | 635 | FLockHandle := nil; 636 | Result := FLockHandle = nil; 637 | end; 638 | 639 | procedure TServiceManager.SetAllowLocking(const AValue: Boolean); 640 | begin 641 | if Active then 642 | begin 643 | HandleError(OPERATION_NOT_ALLOWED_WHILE_ACTIVE); 644 | Exit; 645 | end; 646 | 647 | FAllowLocking := AValue; 648 | end; 649 | 650 | { TServiceInfo } 651 | 652 | procedure TServiceInfo.CleanupHandle; 653 | begin 654 | if FServiceHandle = 0 then 655 | Exit; 656 | 657 | CloseServiceHandle(FServiceHandle); 658 | FServiceHandle := 0; 659 | FServiceHandleAccess := 0; 660 | end; 661 | 662 | constructor TServiceInfo.Create(const AParentServiceManager: TServiceManager); 663 | begin 664 | inherited Create; 665 | 666 | FServiceManager := AParentServiceManager; 667 | 668 | FConfigQueried := False; 669 | FServiceHandle := 0; 670 | FServiceHandleAccess := 0; 671 | FLive := False; 672 | end; 673 | 674 | function TServiceInfo.DependenciesToList(const AQServicesStatus: PEnumServiceStatus; const AServiceInfoCount: Integer): TArray; 675 | var 676 | LServiceName: string; 677 | LIndex: Integer; 678 | LLoopStatusPointer: PEnumServiceStatus; 679 | LServiceInfo: TServiceInfo; 680 | LDependentSerevices: TList; 681 | begin 682 | Result := []; 683 | 684 | LDependentSerevices := TList.Create; 685 | try 686 | LLoopStatusPointer := AQServicesStatus; 687 | 688 | LIndex := 0; 689 | while LIndex <= AServiceInfoCount - 1 do 690 | begin 691 | LServiceName := LLoopStatusPointer^.lpServiceName; 692 | 693 | { Here we have weird issue. 694 | 695 | Getting dependencies of "Windows audio" -service. 696 | we get dirrent name (AarSvc) than than expected AudioEndpointBuilder for the 697 | "Windows Audio Endpoint Builder" - service, hence True parameter for ServiceByName call. 698 | 699 | This is about, Agent Activation Runtime (AarSvc) Service, maybe it is not true service some how, 700 | but possible, did not dig up info. Services manager shows 3 dependencies, two of them is returned 701 | here as expected. 702 | 703 | So we need to have the True parameter at ServiceByName call, that there might be service name 704 | that could not be found. Until fixed, if even possible. 705 | } 706 | LServiceInfo := FServiceManager.ServiceByName(LServiceName, True); 707 | 708 | if Assigned(LServiceInfo) then 709 | LDependentSerevices.Add(LServiceInfo); 710 | 711 | Inc(LLoopStatusPointer); 712 | Inc(LIndex); 713 | end; 714 | 715 | Result := LDependentSerevices.ToArray; 716 | 717 | FServiceManager.SortArray(Result); 718 | finally 719 | LDependentSerevices.Free; 720 | end; 721 | end; 722 | 723 | function TServiceInfo.Dependents: TArray; 724 | var 725 | LServicesStatus: PEnumServiceStatus; 726 | LBytesNeeded: DWORD; 727 | LServicesReturned: DWORD; 728 | begin 729 | Result := []; 730 | 731 | if GetHandle(SERVICE_ENUMERATE_DEPENDENTS) then 732 | try 733 | // See how many dependents we have... 734 | LServicesStatus := nil; 735 | LBytesNeeded := 0; 736 | LServicesReturned := 0; 737 | 738 | if EnumDependentServices(FServiceHandle, SERVICE_ACTIVE + SERVICE_INACTIVE, LServicesStatus, 0, LBytesNeeded, 739 | LServicesReturned) then 740 | Exit; 741 | 742 | if GetLastError <> ERROR_MORE_DATA then 743 | begin 744 | FServiceManager.HandleError(LAST_OS_ERROR); 745 | Exit; 746 | end; 747 | 748 | // Allocate the buffer needed and fetch all info... 749 | GetMem(LServicesStatus, LBytesNeeded); 750 | try 751 | if not EnumDependentServices(FServiceHandle, SERVICE_ACTIVE + SERVICE_INACTIVE, LServicesStatus, LBytesNeeded, 752 | LBytesNeeded, LServicesReturned) then 753 | begin 754 | FServiceManager.HandleError(LAST_OS_ERROR); 755 | Exit; 756 | end; 757 | 758 | Result := DependenciesToList(LServicesStatus, LServicesReturned); 759 | finally 760 | FreeMem(LServicesStatus); 761 | end; 762 | finally 763 | CleanupHandle; 764 | end; 765 | end; 766 | 767 | destructor TServiceInfo.Destroy; 768 | begin 769 | CleanupHandle; 770 | 771 | inherited Destroy; 772 | end; 773 | 774 | function TServiceInfo.GetHandle(const AAccess: DWORD): Boolean; 775 | begin 776 | if HandleOK then 777 | begin 778 | if AAccess = FServiceHandleAccess then 779 | Exit(True) 780 | else 781 | begin 782 | FServiceManager.HandleError(SERVICE_ACCESS_DIFFERS); 783 | Exit(False); 784 | end; 785 | end; 786 | 787 | FServiceManager.ResetLastError; 788 | 789 | FServiceHandle := OpenService(FServiceManager.GetManagerHandle, PChar(FServiceName), AAccess); 790 | 791 | Result := HandleOK; 792 | if not Result then 793 | begin 794 | FServiceManager.HandleError(LAST_OS_ERROR); 795 | Exit; 796 | end 797 | else 798 | FServiceHandleAccess := AAccess; 799 | end; 800 | 801 | function TServiceInfo.GetState: TServiceState; 802 | begin 803 | if FLive then 804 | Query; 805 | 806 | case FServiceStatus.dwCurrentState of 807 | SERVICE_STOPPED: Result := ssStopped; 808 | SERVICE_START_PENDING: Result := ssStartPending; 809 | SERVICE_STOP_PENDING: Result := ssStopPending; 810 | SERVICE_RUNNING: Result := ssRunning; 811 | SERVICE_CONTINUE_PENDING: Result := ssContinuePending; 812 | SERVICE_PAUSE_PENDING: Result := ssPausePending; 813 | SERVICE_PAUSED: Result := ssPaused; 814 | else 815 | begin 816 | FServiceManager.HandleError(SERVICE_STATE_UNKNOWN, True); 817 | Result := ssStopped; // Make compiler happy 818 | end; 819 | end; 820 | end; 821 | 822 | function TServiceInfo.HandleOK: Boolean; 823 | begin 824 | Result := FServiceHandle <> 0; 825 | end; 826 | 827 | function TServiceInfo.InitializeByName(const AServiceName: string): Boolean; 828 | begin 829 | FServiceName := AServiceName; 830 | 831 | Result := QueryConfig; 832 | if Result then 833 | Result := Query; 834 | end; 835 | 836 | function TServiceInfo.Query: Boolean; 837 | var 838 | LStatus: TServiceStatus; 839 | begin 840 | Result := False; 841 | FServiceManager.ResetLastError; 842 | 843 | if HandleOK then 844 | begin 845 | if not QueryServiceStatus(FServiceHandle, LStatus) then 846 | begin 847 | FServiceManager.HandleError(LAST_OS_ERROR); 848 | Exit; 849 | end; 850 | end 851 | else 852 | begin 853 | if not GetHandle(SERVICE_QUERY_STATUS) then 854 | Exit; 855 | 856 | try 857 | if not QueryServiceStatus(FServiceHandle, LStatus) then 858 | begin 859 | FServiceManager.HandleError(LAST_OS_ERROR); 860 | Exit; 861 | end; 862 | finally 863 | CleanupHandle; 864 | end; 865 | end; 866 | 867 | FServiceStatus := LStatus; 868 | Result := True; 869 | end; 870 | 871 | function TServiceInfo.Continue(const AWait: Boolean = True): Boolean; 872 | var 873 | LStatus: TServiceStatus; 874 | begin 875 | Result := False; 876 | 877 | if GetHandle(SERVICE_QUERY_STATUS or SERVICE_PAUSE_CONTINUE) then 878 | try 879 | if not (saPauseContinue in ServiceAccepts) then 880 | begin 881 | FServiceManager.HandleError(SERVICE_CANNOT_CONTINUE); 882 | Exit; 883 | end; 884 | 885 | if not ControlService(FServiceHandle, SERVICE_CONTROL_CONTINUE, LStatus) then 886 | begin 887 | FServiceManager.HandleError(LAST_OS_ERROR); 888 | Exit; 889 | end; 890 | 891 | if AWait then 892 | if not WaitFor(SERVICE_RUNNING) then 893 | Exit; 894 | 895 | Result := True; 896 | finally 897 | CleanupHandle; 898 | end; 899 | end; 900 | 901 | procedure TServiceInfo.ParseBinaryPath; 902 | var 903 | LCommanlineStart: Integer; 904 | begin 905 | FPath := ''; 906 | FFileName := ''; 907 | FCommandLine := ''; 908 | 909 | if FBinaryPathName <> '' then 910 | begin 911 | LCommanlineStart := FBinaryPathName.IndexOf('" '); 912 | if LCommanlineStart < 0 then 913 | LCommanlineStart := FBinaryPathName.IndexOf(' '); 914 | 915 | if LCommanlineStart > 0 then 916 | begin 917 | FCommandLine := FBinaryPathName.Substring(LCommanlineStart + 2); 918 | FFileName := FBinaryPathName.Substring(0, LCommanlineStart + 1); 919 | end 920 | else 921 | FFileName := FBinaryPathName; 922 | 923 | FFileName := FFileName.DeQuotedString('"'); 924 | 925 | FPath := ExtractFilePath(FFileName); 926 | FFileName := ExtractFileName(FFileName); 927 | end; 928 | end; 929 | 930 | function TServiceInfo.Pause(const AWait: Boolean = True): Boolean; 931 | var 932 | LStatus: TServiceStatus; 933 | begin 934 | Result := False; 935 | 936 | if GetHandle(SERVICE_QUERY_STATUS or SERVICE_PAUSE_CONTINUE) then 937 | try 938 | if not (saPauseContinue in ServiceAccepts) then 939 | begin 940 | FServiceManager.HandleError(SERVICE_CANNOT_PAUSE); 941 | Exit; 942 | end; 943 | 944 | if not ControlService(FServiceHandle, SERVICE_CONTROL_PAUSE, LStatus) then 945 | begin 946 | FServiceManager.HandleError(LAST_OS_ERROR); 947 | Exit; 948 | end; 949 | 950 | if AWait then 951 | if not WaitFor(SERVICE_PAUSED) then 952 | Exit; 953 | 954 | Result := True; 955 | finally 956 | CleanupHandle; 957 | end; 958 | end; 959 | 960 | function TServiceInfo.Start(const AWait: Boolean = True): Boolean; 961 | var 962 | LServiceArgumentVectors: PChar; 963 | begin 964 | Result := False; 965 | 966 | if GetHandle(SERVICE_QUERY_STATUS or SERVICE_START) then 967 | try 968 | LServiceArgumentVectors := nil; 969 | if not StartService(FServiceHandle, 0, LServiceArgumentVectors) then 970 | begin 971 | FServiceManager.HandleError(LAST_OS_ERROR); 972 | Exit; 973 | end; 974 | 975 | if AWait then 976 | if not WaitFor(SERVICE_RUNNING) then 977 | Exit; 978 | 979 | Result := True; 980 | finally 981 | CleanupHandle; 982 | end; 983 | end; 984 | 985 | function TServiceInfo.Stop(const AWait: Boolean = True): Boolean; 986 | var 987 | LStatus: TServiceStatus; 988 | begin 989 | Result := False; 990 | 991 | if GetHandle(SERVICE_QUERY_STATUS or SERVICE_STOP) then 992 | try 993 | if not (saStop in ServiceAccepts) then 994 | begin 995 | FServiceManager.HandleError(SERVICE_CANNOT_STOP); 996 | Exit; 997 | end; 998 | 999 | if not ControlService(FServiceHandle, SERVICE_CONTROL_STOP, LStatus) then 1000 | begin 1001 | FServiceManager.HandleError(LAST_OS_ERROR); 1002 | Exit; 1003 | end; 1004 | 1005 | if AWait then 1006 | if not WaitFor(SERVICE_STOPPED) then 1007 | Exit; 1008 | 1009 | Result := True; 1010 | finally 1011 | CleanupHandle; 1012 | end; 1013 | end; 1014 | 1015 | function TServiceInfo.WaitFor(const AState: DWORD): Boolean; 1016 | var 1017 | LOldCheckPoint: DWORD; 1018 | LWait: DWORD; 1019 | begin 1020 | Result := Query; 1021 | 1022 | if Result then 1023 | while AState <> FServiceStatus.dwCurrentState do 1024 | begin 1025 | LOldCheckPoint := FServiceStatus.dwCheckPoint; 1026 | LWait := FServiceStatus.dwWaitHint; 1027 | 1028 | if LWait <= 0 then 1029 | LWait := 5000; 1030 | 1031 | Sleep(LWait); 1032 | 1033 | Query; 1034 | 1035 | if AState = FServiceStatus.dwCurrentState then 1036 | Break 1037 | else if FServiceStatus.dwCheckPoint <> LOldCheckPoint then 1038 | begin 1039 | FServiceManager.HandleError(SERVICE_TIMEOUT); 1040 | Exit(False); 1041 | end; 1042 | end; 1043 | 1044 | Result := AState = FServiceStatus.dwCurrentState; 1045 | end; 1046 | 1047 | function TServiceInfo.WaitForPendingServiceState(const AServiceState: TServiceState): Boolean; 1048 | begin 1049 | case AServiceState of 1050 | ssStartPending: Result := WaitFor(SERVICE_RUNNING); 1051 | ssStopPending: Result := WaitFor(SERVICE_STOPPED); 1052 | ssContinuePending: Result := WaitFor(SERVICE_RUNNING); 1053 | ssPausePending: Result := WaitFor(SERVICE_PAUSED); 1054 | else 1055 | Exit(True); // suppress FixInsight warning 1056 | end; 1057 | end; 1058 | 1059 | function TServiceInfo.QueryConfig: Boolean; 1060 | var 1061 | LServiceConfig: LPQUERY_SERVICE_CONFIG; 1062 | LBytesNeeded: DWORD; 1063 | begin 1064 | Result := False; 1065 | 1066 | if GetHandle(SERVICE_QUERY_CONFIG) then 1067 | try 1068 | // See how large our buffer must be... 1069 | Assert(not QueryServiceConfig(FServiceHandle, nil, 0, LBytesNeeded), 'Could not get buffer size'); 1070 | 1071 | if GetLastError <> ERROR_INSUFFICIENT_BUFFER then 1072 | begin 1073 | FServiceManager.HandleError(LAST_OS_ERROR); 1074 | Exit; 1075 | end; 1076 | 1077 | GetMem(LServiceConfig, LBytesNeeded); 1078 | try 1079 | // Perform the query... 1080 | if not QueryServiceConfig(FServiceHandle, LServiceConfig, LBytesNeeded, LBytesNeeded) then 1081 | begin 1082 | FServiceManager.HandleError(LAST_OS_ERROR); 1083 | Exit; 1084 | end; 1085 | 1086 | // Analyze the query... 1087 | Assert(LServiceConfig^.dwServiceType and SERVICE_WIN32 <> 0); // It must be a WIN32 service 1088 | FOwnProcess := (LServiceConfig^.dwServiceType and SERVICE_WIN32) = SERVICE_WIN32_OWN_PROCESS; 1089 | FInteractive := (LServiceConfig^.dwServiceType and SERVICE_INTERACTIVE_PROCESS) = SERVICE_INTERACTIVE_PROCESS; 1090 | 1091 | if not GetServiceStartType(LServiceConfig^, FStartType) then 1092 | Exit; 1093 | 1094 | FBinaryPathName := LServiceConfig^.lpBinaryPathName; 1095 | ParseBinaryPath; 1096 | 1097 | FUsername := LServiceConfig^.lpServiceStartName; 1098 | 1099 | if FDisplayName = '' then 1100 | FDisplayName := LServiceConfig^.lpDisplayName; 1101 | 1102 | FConfigQueried := True; 1103 | 1104 | Result := True; 1105 | finally 1106 | FreeMem(LServiceConfig); 1107 | end; 1108 | finally 1109 | CleanupHandle; 1110 | end; 1111 | end; 1112 | 1113 | procedure TServiceInfo.RefreshIfNeeded; 1114 | begin 1115 | if FLive or not FConfigQueried then 1116 | QueryConfig; 1117 | end; 1118 | 1119 | function TServiceInfo.GetOwnProcess: Boolean; 1120 | begin 1121 | RefreshIfNeeded; 1122 | 1123 | Result := FOwnProcess; 1124 | end; 1125 | 1126 | function TServiceInfo.GetPath: string; 1127 | begin 1128 | RefreshIfNeeded; 1129 | 1130 | Result := FPath; 1131 | end; 1132 | 1133 | function TServiceInfo.GetInteractive: Boolean; 1134 | begin 1135 | RefreshIfNeeded; 1136 | 1137 | Result := FInteractive; 1138 | end; 1139 | 1140 | function TServiceInfo.GetStartType: TServiceStartup; 1141 | begin 1142 | RefreshIfNeeded; 1143 | 1144 | Result := FStartType; 1145 | end; 1146 | 1147 | function TServiceInfo.GetBinaryPathName: string; 1148 | begin 1149 | RefreshIfNeeded; 1150 | 1151 | Result := FBinaryPathName; 1152 | end; 1153 | 1154 | function TServiceInfo.GetCommandLine: string; 1155 | begin 1156 | RefreshIfNeeded; 1157 | 1158 | Result := FCommandLine; 1159 | end; 1160 | 1161 | function TServiceInfo.GetFileName: string; 1162 | begin 1163 | RefreshIfNeeded; 1164 | 1165 | Result := FFileName; 1166 | end; 1167 | 1168 | function TServiceInfo.GetServiceAccepts: TServiceAccepts; 1169 | begin 1170 | Result := []; 1171 | 1172 | if FLive then 1173 | Query; 1174 | 1175 | if FServiceStatus.dwControlsAccepted and SERVICE_ACCEPT_PAUSE_CONTINUE <> 0 then 1176 | Result := Result + [saPauseContinue]; 1177 | 1178 | if FServiceStatus.dwControlsAccepted and SERVICE_ACCEPT_STOP <> 0 then 1179 | Result := Result + [saStop]; 1180 | 1181 | if FServiceStatus.dwControlsAccepted and SERVICE_ACCEPT_SHUTDOWN <> 0 then 1182 | Result := Result + [saShutdown]; 1183 | end; 1184 | 1185 | 1186 | 1187 | function TServiceInfo.GetServiceStartType(const AServiceConfig: QUERY_SERVICE_CONFIG; var AStartType: TServiceStartup): Boolean; 1188 | begin 1189 | Result := True; 1190 | 1191 | case AServiceConfig.dwStartType of 1192 | SERVICE_AUTO_START: AStartType := ssAutomatic; 1193 | SERVICE_DEMAND_START: AStartType := ssManual; 1194 | SERVICE_DISABLED: AStartType := ssDisabled; 1195 | else 1196 | begin 1197 | FServiceManager.HandleError(SERVICE_STARTTYPE_UNKNOWN); 1198 | Exit(False); 1199 | end; 1200 | end; 1201 | end; 1202 | 1203 | procedure TServiceInfo.SetState(const AServiceState: TServiceState); 1204 | var 1205 | LOldState: TServiceState; 1206 | begin 1207 | // Make sure we have the latest current state and that it is not a transitional state. 1208 | if not FLive then 1209 | Query; 1210 | 1211 | if not WaitForPendingServiceState(GetState) then 1212 | FServiceManager.HandleError(SERVICE_TIMEOUT); 1213 | 1214 | LOldState := GetState; 1215 | // See what we need to do... 1216 | case AServiceState of 1217 | ssStopped: 1218 | if LOldState <> ssStopped then 1219 | Stop(True); 1220 | ssRunning: 1221 | case LOldState of // FI:W535 Enumerated constant(s) missing in case statement 1222 | ssStopped: Start(True); 1223 | ssPaused: Continue(True); 1224 | end; 1225 | ssPaused: 1226 | case LOldState of // FI:W535 Enumerated constant(s) missing in case statement 1227 | ssStopped: 1228 | begin 1229 | Start(True); 1230 | try 1231 | Pause(True); // some services do not support pause/continue! 1232 | except 1233 | Stop(True); 1234 | 1235 | if FServiceManager.RaiseExceptions then 1236 | raise; 1237 | end; 1238 | end; 1239 | ssRunning: Pause(True); 1240 | end; 1241 | else 1242 | begin 1243 | FServiceManager.HandleError(SERVICE_CANNOT_SET_STATE, True); 1244 | Exit; 1245 | end; 1246 | end; 1247 | end; 1248 | 1249 | 1250 | procedure TServiceInfo.SetStartType(const AValue: TServiceStartup); 1251 | const 1252 | NEW_START_TYPES: array [TServiceStartup] of DWORD = (SERVICE_AUTO_START, SERVICE_DEMAND_START, SERVICE_DISABLED); 1253 | begin 1254 | // Check if it is not a change? 1255 | QueryConfig; 1256 | 1257 | if AValue = FStartType then 1258 | Exit; 1259 | 1260 | // Alter it... 1261 | if FServiceManager.Lock then 1262 | try 1263 | if GetHandle(SERVICE_CHANGE_CONFIG) then 1264 | try 1265 | // We locked the manager and are allowed to change the configuration... 1266 | if not ChangeServiceConfig(FServiceHandle, SERVICE_NO_CHANGE, NEW_START_TYPES[AValue], SERVICE_NO_CHANGE, 1267 | nil, nil, nil, nil, nil, nil, nil) then 1268 | begin 1269 | FServiceManager.HandleError(LAST_OS_ERROR); 1270 | Exit; 1271 | end; 1272 | 1273 | // well... we changed it, mark as such 1274 | FStartType := AValue; 1275 | finally 1276 | CleanupHandle; 1277 | end; 1278 | finally 1279 | FServiceManager.Unlock; 1280 | end; 1281 | end; 1282 | 1283 | end. 1284 | --------------------------------------------------------------------------------