1 {
2 $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
3 This file is part of the Free Component Library (FCL)
4 Copyright (c) 1999-2000 by the Free Pascal development team
5
6 See the file COPYING.FPC, included in this distribution,
7 for details about the copyright.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
13 **********************************************************************}
14 {$mode objfpc}
15 {$h+}
16 unit ServiceManager;
17
18 interface
19
20 uses
21 Windows, SysUtils, Classes, jwawinnt, jwawinsvc;
22
23 type
24
25 TServiceEntry = Class(TCollectionItem)
26 Private
27 FServiceName,
28 FDisplayName : String;
29 FServiceType,
30 FCurrentState,
31 FControlsAccepted,
32 FWin32ExitCode,
33 FServiceSpecificExitCode,
34 FCheckPoint,
35 FWaitHint: DWORD;
36 Private
37 Procedure SetStatusFields(Const Status : TServiceStatus);
38 Public
39 Property ServiceName : String Read FServiceName;
40 Property DisplayName : String read FDIsplayName;
41 Property ServiceType : DWord Read FServiceType;
42 Property CurrentState : DWord Read FCurrentState;
43 Property ControlsAccepted : DWord Read FControlsAccepted;
44 Property Win32ExitCode : DWord Read FWin32ExitCode;
45 Property ServiceSpecificExitCode : DWord Read FServiceSpecificExitCode;
46 Property CheckPoint : DWord Read FCheckPoint;
47 Property WaitHint: DWORD Read FWaitHint;
48 end;
49
50 TServiceEntries = Class(TOwnedCollection)
51 Private
GetServicenull52 Function GetService (Index : Integer) : TServiceEntry;
53 Public
FindServicenull54 Function FindService(ServiceName : String) : TServiceEntry;
ServiceByNamenull55 Function ServiceByName(ServiceName : String) : TServiceEntry;
56 Property Items [index : Integer] : TServiceEntry Read GetService;default;
57 end;
58
59 { Record used in
60 registerservice,
61 configservice or
62 queryserviceconfig
63 }
64
65 TServiceDescriptor = Record
66 Name : ShortString;
67 DisplayName : ShortString;
68 DesiredAccess : DWord;
69 ServiceType : DWord;
70 StartType : DWord;
71 ErrorControl : DWord;
72 CommandLine : String;
73 LoadOrderGroup : String;
74 TagID : DWord;
75 Dependencies : String; // Separated by slash signs (/)
76 UserName : String;
77 Password : String;
78 end;
79
80 TServiceManager = class(TComponent)
81 private
82 { Private declarations }
83 FReconnect : Boolean;
84 FMachineName : String;
85 FAccess : DWord;
86 FHandle : THandle;
87 FDBLock : SC_LOCK;
88 FServices : TServiceEntries;
89 FAfterRefresh : TNotifyEvent;
90 FAfterConnect: TNotifyEvent;
91 FRefreshOnConnect: Boolean;
92 FBeforeDisConnect: TNotifyEvent;
GetConnectednull93 function GetConnected: Boolean;
94 procedure SetConnected(const Value: Boolean);
95 procedure SetMachineName(const Value: string);
96 protected
97 { Protected declarations }
98 procedure Loaded;override;
99 Procedure SMError(Msg : String);
100 Procedure CheckConnected(Msg : String);
101 Procedure DoBeforeDisConnect; virtual;
102 Procedure DoAfterConnect; virtual;
103 Procedure DoAfterRefresh; virtual;
104 public
105 { Public declarations }
106 Constructor Create(AOwner: TComponent); override;
107 Destructor Destroy; override;
108 Procedure ClearServices;
109 Procedure Refresh;
110 Procedure Connect;
111 Procedure Disconnect;
GetServiceHandlenull112 function GetServiceHandle(ServiceName: String; SAccess: DWord): THandle;
113 procedure ContinueService(SHandle: THandle); overload;
114 procedure ContinueService(ServiceName : String); overload;
115 procedure StartService(SHandle: THandle; Args: TStrings);overload;
116 procedure StartService(ServiceName : String; Args: TStrings); overload;
117 procedure StopService(ServiceName: String; StopDependent: Boolean); overload;
118 procedure StopService(SHandle : THandle; StopDependent: Boolean); overload;
119 procedure PauseService(SHandle: THandle);overload;
120 procedure PauseService(ServiceName: String);Overload;
121 procedure CustomControlService(ServiceName : String; ControlCode : DWord); overload;
122 procedure CustomControlService(Shandle : THandle; ControlCode : DWord); overload;
123 procedure ListDependentServices(SHandle: THandle; ServiceState: DWord; List: TStrings); overload;
124 procedure ListDependentServices(ServiceName : String; ServiceState : DWord; List : TStrings); overload;
125 Procedure LockServiceDatabase;
126 Procedure UnlockServiceDatabase;
127 procedure QueryServiceConfig(SHandle : THandle; Var Config : TServiceDescriptor);overload;
128 procedure QueryServiceConfig(ServiceName : String; Var Config : TServiceDescriptor);overload;
RegisterServicenull129 Function RegisterService(Var Desc : TServiceDescriptor) : THandle;
130 procedure SetStartupType(ServiceName: String; StartupType: DWord); overload;
131 procedure SetStartupType(SHandle : THandle; StartupType: DWord); overload;
132 Procedure UnregisterService(ServiceName : String);
133 procedure ConfigService(SHandle: THandle; Config: TServiceDescriptor); overload;
134 procedure ConfigService(ServiceName : string; Config: TServiceDescriptor); overload;
135 procedure RefreshServiceStatus(ServiceName: String);
136 procedure GetServiceStatus(SHandle : THandle; Var Status : TServiceStatus); overload;
137 procedure GetServiceStatus(ServiceName : String; Var Status : TServiceStatus); overload;
138 Property Handle : THandle Read FHandle;
139 Property Access : DWord read FAccess Write FAccess;
140 Property Acces : DWord read FAccess Write FAccess; deprecated; //Kept for compatibility
141 Property Services : TServiceEntries Read FServices;
142 published
143 { Published declarations }
144 Property Connected : Boolean Read GetConnected Write SetConnected;
145 Property MachineName : string Read FMachineName Write SetMachineName;
146 Property RefreshOnConnect : Boolean Read FRefreshOnConnect Write FrefreshOnConnect;
147 Property AfterRefresh : TNotifyEvent Read FAfterRefresh Write FAfterRefresh;
148 Property AfterConnect : TNotifyEvent Read FAfterConnect Write FAfterConnect;
149 Property BeforeDisConnect : TNotifyEvent Read FBeforeDisConnect Write FBeforeDisConnect;
150 end;
151
152 EServiceManager = Class(Exception);
153
154 Const
155 StartTypes : Array[0..4] of DWord = (
156 SERVICE_AUTO_START,SERVICE_BOOT_START, SERVICE_DEMAND_START,
157 SERVICE_SYSTEM_START, SERVICE_DISABLED );
158 ServiceTypes : Array[0..3] of DWord = (
159 SERVICE_FILE_SYSTEM_DRIVER, SERVICE_KERNEL_DRIVER,
160 SERVICE_WIN32_OWN_PROCESS, SERVICE_WIN32_SHARE_PROCESS );
161 StartErrors : Array[0..3] of DWord = (
162 SERVICE_ERROR_IGNORE, SERVICE_ERROR_NORMAL,
163 SERVICE_ERROR_SEVERE, SERVICE_ERROR_CRITICAL);
164
ServiceTypeToStringnull165 Function ServiceTypeToString(AType : Dword) : String;
ServiceStateToStringnull166 Function ServiceStateToString(AState : DWord) : String;
ControlsAcceptedToStringnull167 Function ControlsAcceptedToString(AValue : DWord) : String;
IsInteractiveServicenull168 Function IsInteractiveService(AType : Dword) : Boolean;
169
170 implementation
171
172
173 ResourceString
174 SErrConnected = 'Operation not permitted while connected to Service Control Manager';
175 SErrNotConnected = 'Not connected to Service control manager. Cannot %s';
176 SErrInvalidControlCode = 'Invalid custom control code : %d';
177 SQueryServiceList = 'Query service list';
178 SActive = 'Active';
179 SInactive = 'Inactive';
180 SStopped = 'Stopped';
181 SStartPending = 'Start pending';
182 SStopPending = 'Stop pending';
183 SRunning = 'Running';
184 SContinuePending = 'Continue pending';
185 SPausePending = 'Pause pending';
186 SPaused = 'Paused';
187 SUnknownState = 'Unknown State (%d)';
188 SUnknownType = 'Unknown type (%d)';
189 SStop = 'Stop';
190 SPauseContinue = 'Pause/continue';
191 SShutDown = 'Shutdown';
192 SDeviceDriver = 'Device driver';
193 SFileSystemDriver = 'Filesystem driver';
194 SAdapter = 'Adapter';
195 SRecognizer = 'Recognizer';
196 SService = 'Service';
197 SSHaredService = 'Service (shared)';
198 SErrServiceNotFound = 'Service "%s" not found.';
199
200
201 { TServiceManager }
202
203 {$ifdef ver130}
204
205 Type
206 PCharArray = Array[Word] of PChar;
207 PPCharArray = ^PCharArray;
208
209 Procedure RaiseLastOSError;
210
211 begin
212 RaiseLastWin32Error;
213 end;
214 {$endif}
215
216 procedure TServiceManager.CheckConnected(Msg: String);
217 begin
218 If Not Connected then
219 SMError(Format(SErrNotConnected,[Msg]));
220 end;
221
222 procedure TServiceManager.ClearServices;
223 begin
224 FServices.Clear;
225 end;
226
227 procedure TServiceManager.Connect;
228
229 Var
230 P : PChar;
231
232 begin
233 If (FHandle=0) then
234 begin
235 P:=Nil;
236 If (MachineName<>'') then
237 P:=PChar(MachineName);
238 FHandle:=OpenSCManager(P,Nil,FAccess);
239 If (FHandle=0) then
240 RaiseLastOSError;
241 DoAfterConnect;
242 If RefreshOnConnect then
243 Refresh;
244 end;
245 end;
246
247 constructor TServiceManager.Create(AOwner: TComponent);
248 begin
249 inherited;
250 FServices:=TServiceEntries.Create(Self,TServiceEntry);
251 FAccess:=SC_MANAGER_ALL_ACCESS;
252 end;
253
254 destructor TServiceManager.Destroy;
255 begin
256 FServices.Free;
257 Inherited;
258 end;
259
260 procedure TServiceManager.Disconnect;
261 begin
262 IF (FHandle<>0) then
263 begin
264 DoBeforeDisConnect;
265 CloseServiceHandle(FHandle);
266 FHandle:=0;
267 end;
268 end;
269
GetConnectednull270 function TServiceManager.GetConnected: Boolean;
271 begin
272 Result:=(Handle<>0);
273 end;
274
275 procedure TServiceManager.Refresh;
276
277 Var
278 BytesNeeded,
279 ServicesReturned,
280 ResumeHandle : DWord;
281 Info,P : PEnumServiceStatus;
282 E : TServiceEntry;
283 I : integer;
284
285 begin
286 ClearServices;
287 CheckConnected(SQueryServiceList);
288 BytesNeeded:=0;
289 ServicesReturned:=0;
290 ResumeHandle:=0;
291 Info:=Nil;
292 EnumServicesStatus(FHandle,SERVICE_WIN32,SERVICE_STATE_ALL,Info,0,
293 BytesNeeded,ServicesReturned,Resumehandle);
294 if (GetLastError<>ERROR_MORE_DATA) then
295 RaiseLastOSError;
296 Getmem(Info,BytesNeeded);
297 Try
298 P:=Info;
299 If Not EnumServicesStatus(FHandle,SERVICE_WIN32,SERVICE_STATE_ALL,Info,BytesNeeded,
300 BytesNeeded,ServicesReturned,Resumehandle) then
301 RaiseLastOSError;
302 For I:=1 to Servicesreturned do
303 begin
304 E:=FServices.Add as TServiceEntry;
305 With E,P^ do
306 begin
307 FServiceName:=StrPas(lpServiceName);
308 FDisplayName:=StrPas(lpDisplayName);
309 SetStatusFields(ServiceStatus);
310 end;
311 PChar(P):=Pchar(P)+SizeOf(TEnumServiceStatus);
312 end;
313 Finally
314 FreeMem(Info);
315 end;
316 DoAfterRefresh;
317 end;
318
319 procedure TServiceManager.SetConnected(const Value: Boolean);
320 begin
321 If (([csLoading,csdesigning] * ComponentState)<>[]) then
322 FReconnect:=Value
323 else
324 If Value<>GetConnected then
325 If Value then
326 Connect
327 Else
328 Disconnect;
329 end;
330
331 procedure TServiceManager.Loaded;
332
333 begin
334 Inherited;
335 If FReconnect then
336 Connect;
337 end;
338
339 procedure TServiceManager.SetMachineName(const Value: string);
340 begin
341 If Connected then
342 SMError(SErrConnected);
343 FMachineName := Value;
344 end;
345
346 procedure TServiceManager.SMError(Msg: String);
347 begin
348 raise EServiceManager.Create(Msg);
349 end;
350
ServiceTypeToStringnull351 Function ServiceTypeToString(AType : Dword) : String;
352
353 begin
354 Case (AType and $FF) of
355 SERVICE_KERNEL_DRIVER : Result:=SDeviceDriver;
356 SERVICE_FILE_SYSTEM_DRIVER : Result:=SFileSystemDriver;
357 SERVICE_ADAPTER : Result:=SAdapter;
358 SERVICE_RECOGNIZER_DRIVER : Result:=SRecognizer;
359 SERVICE_WIN32_OWN_PROCESS : Result:=SService;
360 SERVICE_WIN32_SHARE_PROCESS : Result:=SSHaredService;
361 else
362 Result:=Format(SUnknownType,[AType]);
363 end;
364 end;
365
IsInteractiveServicenull366 Function IsInteractiveService(AType : Dword) : Boolean;
367
368 begin
369 Result:=(Atype and SERVICE_INTERACTIVE_PROCESS)<>0;
370 end;
371
ServiceStateToStringnull372 Function ServiceStateToString(AState : Dword) : String;
373
374 begin
375 Case AState of
376 SERVICE_STOPPED : Result:=SStopped;
377 SERVICE_START_PENDING : Result:=SStartPending;
378 SERVICE_STOP_PENDING : Result:=SStopPending;
379 SERVICE_RUNNING : Result:=SRunning;
380 SERVICE_CONTINUE_PENDING : Result:=SContinuePending;
381 SERVICE_PAUSE_PENDING : Result:=SPausePending;
382 SERVICE_PAUSED : Result:=SPaused;
383 else
384 Result:=Format(SUnknownState,[AState]);
385 end;
386 end;
387
ControlsAcceptedToStringnull388 Function ControlsAcceptedToString(AValue : DWord) : String;
389
390 Procedure AddToResult(S : String);
391 begin
392 If (Result='') then
393 Result:=S
394 else
395 Result:=Result+','+S
396 end;
397
398 begin
399 Result:='';
400 If (AValue and SERVICE_ACCEPT_STOP)<>0 then
401 AddToResult(SStop);
402 If (AValue and SERVICE_ACCEPT_PAUSE_CONTINUE)<>0 then
403 AddToResult(SPauseContinue);
404 If (AValue and SERVICE_ACCEPT_SHUTDOWN)<>0 then
405 AddToResult(SShutDown)
406 end;
407
408 procedure TServiceManager.DoAfterConnect;
409 begin
410 If Assigned(FAfterConnect) then
411 FAfterConnect(Self);
412 end;
413
414 procedure TServiceManager.DoAfterRefresh;
415 begin
416 If Assigned(FAfterRefresh) then
417 FAfterRefresh(Self);
418
419 end;
420
421 procedure TServiceManager.DoBeforeDisConnect;
422 begin
423 If Assigned(FBeforeDisconnect) then
424 FBeforeDisconnect(Self);
425 end;
426
AllocDependencyListnull427 Function AllocDependencyList (Const S : String) : PChar;
428
429 Var
430 I,L : Integer;
431
432 begin
433 Result:=Nil;
434 If (S<>'') then
435 begin
436 // Double Null terminated list of null-terminated strings.
437 L:=Length(S);
438 GetMem(Result,L+3);
439 Move(S[1],Result^,L+1); // Move terminating null as well.
440 Result[L+1]:=#0;
441 Result[L+2]:=#0;
442 For I:=0 to L-1 do
443 If Result[i]='/' then // Change / to #0.
444 Result[i]:=#0;
445 end;
446 end;
447
TServiceManager.RegisterServicenull448 Function TServiceManager.RegisterService(var Desc: TServiceDescriptor) : Thandle;
449
450 Var
451 PDep,PLO,PUser,PPWd : PChar; // We need Nil for some things.
452 N,D : String;
453 ReturnTag : DWord;
454
455 begin
456 With Desc do
457 begin
458 N:=Name;
459 D:=DisplayName;
460 If (LoadOrderGroup='') then
461 PLO:=Nil
462 else
463 PLO:=PChar(LoadOrderGroup);
464 PPwd:=Nil;
465 PUser:=Nil;
466 If (UserName<>'') then
467 begin
468 PUser:=PChar(UserName);
469 If (Password<>'') then
470 PPWd:=PChar(Password);
471 end;
472 PDep:=AllocDependencyList(Dependencies);
473 Try
474 Result:=CreateService(Self.Handle,PChar(N),PChar(D),DesiredAccess,ServiceType,
475 StartType,ErrorControl,PChar(CommandLine),PLO,Nil,
476 PDep,PUser,PPwd);
477 If (Result=0) then
478 RaiseLastOSError;
479 Finally
480 If PDep<>Nil then
481 FreeMem(PDep);
482 end;
483 end;
484 end;
485
486 procedure TServiceManager.ListDependentServices(ServiceName : String; ServiceState : DWord; List : TStrings);
487
488 Var
489 H : THandle;
490
491 begin
492 H:=OpenService(Handle,PChar(ServiceName),SERVICE_ENUMERATE_DEPENDENTS);
493 try
494 ListDependentServices(H,ServiceState,List);
495 Finally
496 CloseServiceHandle(H);
497 end;
498 end;
499
500
501 procedure TServiceManager.ListDependentServices(SHandle: THandle; ServiceState : DWord; List : TStrings);
502
503 Var
504 P,E : PEnumServiceStatus;
505 I,BytesNeeded,Count : DWord;
506
507 begin
508 P:=Nil;
509 List.Clear;
510 // If call succeeds with size 0, then there are no dependent services...
511 if Not EnumDependentServices(SHandle,ServiceState,P,0,BytesNeeded,Count) then
512 begin
513 If (GetLastError<>ERROR_MORE_DATA) then
514 RaiseLastOSError;
515 GetMem(P,BytesNeeded);
516 Try
517 If Not EnumDependentServices(SHandle,ServiceState,P,bytesNeeded,BytesNeeded,Count) Then
518 RaiseLastOSError;
519 E:=P;
520 For I:=0 to Count-1 do
521 begin
522 List.Add(StrPas(E^.lpServiceName));
523 Pchar(E):=PChar(E)+SizeOf(TEnumServiceStatus);
524 end;
525 Finally
526 FreeMem(P);
527 end;
528 end;
529 end;
530
531
532 Procedure TServiceManager.StopService(SHandle : THandle; StopDependent : Boolean);
533
534 Var
535 I : Integer;
536 List : TStrings;
537 Status : TServiceStatus;
538
539 begin
540 If Not QueryServiceStatus(SHandle,Status) then
541 RaiseLastOSError;
542 If Not (Status.dwCurrentState=SERVICE_STOPPED) then
543 begin
544 If StopDependent then
545 begin
546 List:=TStringList.Create;
547 Try
548 ListDependentServices(SHandle,SERVICE_ACTIVE,List);
549 For I:=0 to List.Count-1 do
550 StopService(List[i],False); // Do not recurse !!
551 Finally
552 List.Free;
553 end;
554 end;
555 If Not ControlService(SHandle,SERVICE_CONTROL_STOP,Status) then
556 RaiseLastOSError;
557 end;
558 end;
559
560 Procedure TServiceManager.StopService(ServiceName : String; StopDependent : Boolean);
561
562 Var
563 H : THandle;
564 A : DWORD;
565
566 begin
567 A:=SERVICE_STOP or SERVICE_QUERY_STATUS;
568 If StopDependent then
569 A:=A or SERVICE_ENUMERATE_DEPENDENTS;
570 H:=OpenService(Handle,PChar(ServiceName),A);
571 Try
572 StopService(H,StopDependent);
573 Finally
574 CloseServiceHandle(H);
575 end;
576 end;
577
578
TServiceManager.GetServiceHandlenull579 Function TServiceManager.GetServiceHandle(ServiceName : String; SAccess : DWord) : THandle;
580
581 begin
582 Result:=OpenService(Handle,PChar(ServiceName),SAccess);
583 If (Result=0) then
584 RaiseLastOSError;
585 end;
586
587 procedure TServiceManager.UnregisterService(ServiceName: String);
588
589 Var
590 H : THandle;
591 Status : TServiceStatus;
592
593 begin
594 StopService(ServiceName,True);
595 H:=GetServiceHandle(ServiceName,SERVICE_STOP or SERVICE_QUERY_STATUS or SERVICE_DELETE);
596 Try
597 If Not DeleteService(H) then
598 RaiseLastOSError;
599 Finally
600 CloseServiceHandle(H);
601 end;
602 end;
603
604 Procedure TServiceManager.PauseService(SHandle : THandle);
605
606 Var
607 Status : TServiceStatus;
608
609 begin
610 If Not ControlService(SHandle,SERVICE_CONTROL_PAUSE,Status) then
611 RaiseLastOSError;
612 end;
613
614 Procedure TServiceManager.PauseService(ServiceName : String);
615
616 Var
617 H : THandle;
618
619 begin
620 H:=GetServiceHandle(ServiceName,SERVICE_PAUSE_CONTINUE);
621 Try
622 PauseService(H);
623 Finally
624 CloseServiceHandle(H);
625 end;
626 end;
627
628 Procedure TServiceManager.ContinueService(SHandle : THandle);
629
630 Var
631 Status : TServiceStatus;
632
633 begin
634 If Not ControlService(SHandle,SERVICE_CONTROL_CONTINUE,Status) then
635 RaiseLastOSError;
636 end;
637
638 Procedure TServiceManager.ContinueService(ServiceName : String);
639
640 Var
641 H : THandle;
642
643 begin
644 H:=GetServiceHandle(ServiceName,SERVICE_PAUSE_CONTINUE);
645 Try
646 ContinueService(H);
647 Finally
648 CloseServiceHandle(H);
649 end;
650 end;
651
StringsToPCharListnull652 Function StringsToPCharList(List : TStrings) : PPChar;
653
654 Var
655 I : Integer;
656 S : String;
657
658 begin
659 I:=(List.Count)+1;
660 GetMem(Result,I*sizeOf(PChar));
661 PPCharArray(Result)^[List.Count]:=Nil;
662 For I:=0 to List.Count-1 do
663 begin
664 S:=List[i];
665 PPCharArray(Result)^[i]:=StrNew(PChar(S));
666 end;
667 end;
668
669 Procedure FreePCharList(List : PPChar);
670
671 Var
672 I : integer;
673
674 begin
675 I:=0;
676 While PPChar(List)[i]<>Nil do
677 begin
678 StrDispose(PPChar(List)[i]);
679 Inc(I);
680 end;
681 FreeMem(List);
682 end;
683
684 Procedure TServiceManager.StartService(SHandle : THandle; Args : TStrings);
685
686 Var
687 Argc : DWord;
688 PArgs : PPchar;
689
690 begin
691 If (Args=Nil) or (Args.Count>0) then
692 begin
693 Argc:=0;
694 Pargs:=Nil;
695 end
696 else
697 begin
698 ArgC:=Args.Count;
699 Pargs:=StringsToPcharList(Args);
700 end;
701 Try
702 If not jwawinsvc.StartService(SHandle,Argc,Pchar(PArgs)) then
703 RaiseLastOSError;
704 Finally
705 If (PArgs<>Nil) then
706 FreePCharList(PArgs);
707 end;
708 end;
709
710
711 Procedure TServiceManager.StartService(ServiceName : String; Args : TStrings);
712
713 Var
714 H : THandle;
715
716 begin
717 H:=GetServiceHandle(ServiceName,SERVICE_START);
718 Try
719 StartService(H,Args);
720 Finally
721 CloseServiceHandle(H);
722 end;
723 end;
724
725 Procedure TServiceManager.LockServiceDatabase;
726
727 begin
728 FDBLock:=jwawinsvc.LockServiceDatabase(Handle);
729 If FDBLock=Nil then
730 RaiseLastOSError;
731 end;
732
733 procedure TServiceManager.UnlockServiceDatabase;
734 begin
735 If (FDBLock<>Nil) then
736 begin
737 Try
738 If Not jwawinsvc.UnLockServiceDatabase(FDBLock) then
739 RaiseLastOSError;
740 Finally
741 FDBLock:=Nil;
742 end;
743 end;
744 end;
745
746 procedure TServiceManager.QueryServiceConfig(SHandle : THandle; Var Config : TServiceDescriptor);
747
748 Var
749 SvcCfg : PQueryServiceConfig;
750 BytesNeeded : DWord;
751
752 begin
753 jwawinsvc.QueryServiceConfig(SHandle,Nil,0,BytesNeeded);
754 If (GetLastError<>ERROR_INSUFFICIENT_BUFFER) then
755 RaiseLastOSError;
756 GetMem(SvcCfg,BytesNeeded);
757 Try
758 If Not jwawinsvc.QueryServiceConfig(SHandle,SvcCfg,BytesNeeded,BytesNeeded) then
759 RaiseLastOSError;
760 With config,SvcCfg^ do
761 begin
762 Password:='';
763 Name:='';
764 DesiredAccess:=0;
765 ErrorControl:=dwErrorControl;
766 ServiceType:=dwServiceType;
767 StartType:=dwStartType;
768 TagID:=dwTagID;
769 CommandLine:=lpBinaryPathName;
770 LoadOrderGroup:=lpLoadOrderGroup;
771 Dependencies:=lpDependencies;
772 UserName:=lpServiceStartName;
773 DisplayName:=lpDisplayName;
774 end;
775 Finally
776 FreeMem(SvcCfg,BytesNeeded);
777 end;
778 end;
779
780 procedure TServiceManager.QueryServiceConfig(ServiceName : String; Var Config : TServiceDescriptor);
781
782 Var
783 H : THandle;
784
785 begin
786 H:=GetServiceHandle(ServiceName,SERVICE_QUERY_CONFIG);
787 Try
788 QueryServiceConfig(H,Config);
789 Finally
790 CloseServiceHandle(H);
791 end;
792 end;
793
794 procedure TServiceManager.SetStartupType(ServiceName : String; StartupType : DWord);
795
796 Var
797 H : THandle;
798
799 begin
800 H:=GetServiceHandle(ServiceName,SERVICE_CHANGE_CONFIG);
801 Try
802 SetStartupType(H,StartupType);
803 Finally
804 CloseServiceHandle(H);
805 end;
806 end;
807
808 procedure TServiceManager.SetStartupType(SHandle : THandle; StartupType: DWord);
809
810 Const
811 SNC = SERVICE_NO_CHANGE; // Shortcut
812
813 begin
814 If Not ChangeServiceConfig(SHandle,SNC,StartupType,SNC,Nil,Nil,Nil,Nil,Nil,Nil,Nil) then
815 RaiseLastOSError;
816 end;
817
818 procedure TServiceManager.ConfigService(SHandle : THandle ; Config : TServiceDescriptor);
819
SToPcharnull820 Function SToPchar(Var S : String) : PChar;
821
822 begin
823 If (S='') then
824 Result:=Nil
825 else
826 Result:=PChar(S);
827 end;
828
829 Var
830 PDep,PLO,PUser,PPWd,PCmd,PDisp : PChar; // We need Nil for some things.
831 D : String;
832 ReturnTag : DWord;
833
834 begin
835 With Config do
836 begin
837 PCmd:=SToPChar(CommandLine);
838 D:=DisplayName;
839 PDisp:=StoPChar(D);
840 PLO:=SToPChar(LoadOrderGroup);
841 PUser:=SToPChar(UserName);
842 PPwd:=SToPchar(Password);
843 PDep:=AllocDependencyList(Dependencies);
844 Try
845 If Not ChangeServiceConfig(SHandle,ServiceType,StartType,ErrorControl,
846 PCmd,PLO,Nil,PDep,PUser,PPwd,PDisp) then
847 RaiseLastOSError;
848 Finally
849 If PDep<>Nil then
850 FreeMem(PDep);
851 end;
852 end;
853 end;
854
855 procedure TServiceManager.GetServiceStatus(SHandle : THandle; Var Status: TServiceStatus);
856
857 begin
858 If Not QueryServiceStatus(SHandle,Status) then
859 RaiseLastOSError;
860 end;
861
862 procedure TServiceManager.GetServiceStatus(ServiceName : String; Var Status: TServiceStatus);
863
864 Var
865 H : THandle;
866
867 begin
868 H:=GetServiceHandle(ServiceName,SERVICE_QUERY_STATUS);
869 Try
870 GetServiceStatus(H,Status);
871 Finally
872 CloseServiceHandle(H);
873 end;
874 end;
875
876 procedure TServiceManager.RefreshServiceStatus(ServiceName : String);
877
878 Var
879 Status : TServiceStatus;
880 SE : TServiceEntry;
881
882
883 begin
884 SE:=Services.ServiceByName(ServiceName);
885 GetServiceStatus(ServiceName,Status);
886 SE.SetStatusFields(Status);
887 end;
888
889
890 procedure TServiceManager.ConfigService(ServiceName : String; Config : TServiceDescriptor);
891
892 Var
893 H : THandle;
894
895 begin
896 H:=GetServiceHandle(ServiceName,SERVICE_CHANGE_CONFIG);
897 Try
898 ConfigService(H,Config);
899 Finally
900 CloseServiceHandle(H);
901 end;
902 end;
903
904
905 procedure TServiceManager.CustomControlService(ServiceName: String; ControlCode: DWord);
906
907 Var
908 H : THandle;
909
910 begin
911 H:=GetServiceHandle(ServiceName,SERVICE_USER_DEFINED_CONTROL);
912 Try
913 CustomControlService(H,ControlCode);
914 Finally
915 CloseServiceHandle(H);
916 end;
917 end;
918
919 procedure TServiceManager.CustomControlService(Shandle: THandle;
920 ControlCode: DWord);
921
922 Var
923 Status : TServiceStatus;
924
925 begin
926 If (ControlCode<128) or (ControlCode>255) then
927 Raise EServiceManager.CreateFmt(SErrInvalidControlCode,[ControlCode]);
928 If Not ControlService(SHandle,ControlCode,Status) then
929 RaiseLastOSError;
930 end;
931
932 { TServiceEntries }
933
TServiceEntries.FindServicenull934 function TServiceEntries.FindService(ServiceName: String): TServiceEntry;
935
936 Var
937 I : Integer;
938
939 begin
940 Result:=Nil;
941 I:=Count-1;
942 While (I>=0) and (Result=Nil) do
943 If CompareText(Items[i].ServiceName,ServiceName)=0 then
944 Result:=Items[i]
945 else
946 Dec(I);
947 end;
948
TServiceEntries.GetServicenull949 function TServiceEntries.GetService(Index: Integer): TServiceEntry;
950 begin
951 Result:=inherited Items[Index] as TServiceEntry;
952 end;
953
ServiceByNamenull954 function TServiceEntries.ServiceByName(ServiceName: String): TServiceEntry;
955
956 begin
957 Result:=FindService(ServiceName);
958 If Result=Nil then
959 Raise EServiceManager.CreateFmt(SErrServiceNotFound,[ServiceName]);
960 end;
961
962 { TServiceEntry }
963
964 procedure TServiceEntry.SetStatusFields(const Status: TServiceStatus);
965 begin
966 With Status do
967 begin
968 FServiceType:=dwServiceType;
969 FCurrentState:=dwCurrentState;
970 FControlsAccepted:=dwControlsAccepted;
971 FWin32ExitCode:=dwWin32ExitCode;
972 FServiceSpecificExitCode:=dwServiceSpecificExitCode;
973 FCheckPoint:=dwCheckPoint;
974 FWaitHint:=dwWaitHint;
975 end;
976 end;
977
978 end.
979