ServiceManager.pas 24 KB

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