123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978 |
- {
- $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
- This file is part of the Free Component Library (FCL)
- Copyright (c) 1999-2000 by the Free Pascal development team
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {$mode objfpc}
- {$h+}
- unit ServiceManager;
- interface
- uses
- Windows, SysUtils, Classes, jwawinnt, jwawinsvc;
- type
- TServiceEntry = Class(TCollectionItem)
- Private
- FServiceName,
- FDisplayName : String;
- FServiceType,
- FCurrentState,
- FControlsAccepted,
- FWin32ExitCode,
- FServiceSpecificExitCode,
- FCheckPoint,
- FWaitHint: DWORD;
- Private
- Procedure SetStatusFields(Const Status : TServiceStatus);
- Public
- Property ServiceName : String Read FServiceName;
- Property DisplayName : String read FDIsplayName;
- Property ServiceType : DWord Read FServiceType;
- Property CurrentState : DWord Read FCurrentState;
- Property ControlsAccepted : DWord Read FControlsAccepted;
- Property Win32ExitCode : DWord Read FWin32ExitCode;
- Property ServiceSpecificExitCode : DWord Read FServiceSpecificExitCode;
- Property CheckPoint : DWord Read FCheckPoint;
- Property WaitHint: DWORD Read FWaitHint;
- end;
- TServiceEntries = Class(TOwnedCollection)
- Private
- Function GetService (Index : Integer) : TServiceEntry;
- Public
- Function FindService(ServiceName : String) : TServiceEntry;
- Function ServiceByName(ServiceName : String) : TServiceEntry;
- Property Items [index : Integer] : TServiceEntry Read GetService;default;
- end;
- { Record used in
- registerservice,
- configservice or
- queryserviceconfig
- }
- TServiceDescriptor = Record
- Name : ShortString;
- DisplayName : ShortString;
- DesiredAccess : DWord;
- ServiceType : DWord;
- StartType : DWord;
- ErrorControl : DWord;
- CommandLine : String;
- LoadOrderGroup : String;
- TagID : DWord;
- Dependencies : String; // Separated by slash signs (/)
- UserName : String;
- Password : String;
- end;
- TServiceManager = class(TComponent)
- private
- { Private declarations }
- FReconnect : Boolean;
- FMachineName : String;
- FAccess : DWord;
- FHandle : THandle;
- FDBLock : SC_LOCK;
- FServices : TServiceEntries;
- FAfterRefresh : TNotifyEvent;
- FAfterConnect: TNotifyEvent;
- FRefreshOnConnect: Boolean;
- FBeforeDisConnect: TNotifyEvent;
- function GetConnected: Boolean;
- procedure SetConnected(const Value: Boolean);
- procedure SetMachineName(const Value: string);
- protected
- { Protected declarations }
- procedure Loaded;override;
- Procedure SMError(Msg : String);
- Procedure CheckConnected(Msg : String);
- Procedure DoBeforeDisConnect; virtual;
- Procedure DoAfterConnect; virtual;
- Procedure DoAfterRefresh; virtual;
- public
- { Public declarations }
- Constructor Create(AOwner: TComponent); override;
- Destructor Destroy; override;
- Procedure ClearServices;
- Procedure Refresh;
- Procedure Connect;
- Procedure Disconnect;
- function GetServiceHandle(ServiceName: String; SAccess: DWord): THandle;
- procedure ContinueService(SHandle: THandle); overload;
- procedure ContinueService(ServiceName : String); overload;
- procedure StartService(SHandle: THandle; Args: TStrings);overload;
- procedure StartService(ServiceName : String; Args: TStrings); overload;
- procedure StopService(ServiceName: String; StopDependent: Boolean); overload;
- procedure StopService(SHandle : THandle; StopDependent: Boolean); overload;
- procedure PauseService(SHandle: THandle);overload;
- procedure PauseService(ServiceName: String);Overload;
- procedure CustomControlService(ServiceName : String; ControlCode : DWord); overload;
- procedure CustomControlService(Shandle : THandle; ControlCode : DWord); overload;
- procedure ListDependentServices(SHandle: THandle; ServiceState: DWord; List: TStrings); overload;
- procedure ListDependentServices(ServiceName : String; ServiceState : DWord; List : TStrings); overload;
- Procedure LockServiceDatabase;
- Procedure UnlockServiceDatabase;
- procedure QueryServiceConfig(SHandle : THandle; Var Config : TServiceDescriptor);overload;
- procedure QueryServiceConfig(ServiceName : String; Var Config : TServiceDescriptor);overload;
- Function RegisterService(Var Desc : TServiceDescriptor) : THandle;
- procedure SetStartupType(ServiceName: String; StartupType: DWord); overload;
- procedure SetStartupType(SHandle : THandle; StartupType: DWord); overload;
- Procedure UnregisterService(ServiceName : String);
- procedure ConfigService(SHandle: THandle; Config: TServiceDescriptor); overload;
- procedure ConfigService(ServiceName : string; Config: TServiceDescriptor); overload;
- procedure RefreshServiceStatus(ServiceName: String);
- procedure GetServiceStatus(SHandle : THandle; Var Status : TServiceStatus); overload;
- procedure GetServiceStatus(ServiceName : String; Var Status : TServiceStatus); overload;
- Property Handle : THandle Read FHandle;
- Property Acces : DWord read FAccess Write FAccess;
- Property Services : TServiceEntries Read FServices;
- published
- { Published declarations }
- Property Connected : Boolean Read GetConnected Write SetConnected;
- Property MachineName : string Read FMachineName Write SetMachineName;
- Property RefreshOnConnect : Boolean Read FRefreshOnConnect Write FrefreshOnConnect;
- Property AfterRefresh : TNotifyEvent Read FAfterRefresh Write FAfterRefresh;
- Property AfterConnect : TNotifyEvent Read FAfterConnect Write FAfterConnect;
- Property BeforeDisConnect : TNotifyEvent Read FBeforeDisConnect Write FBeforeDisConnect;
- end;
- EServiceManager = Class(Exception);
- Const
- StartTypes : Array[0..4] of DWord = (
- SERVICE_AUTO_START,SERVICE_BOOT_START, SERVICE_DEMAND_START,
- SERVICE_SYSTEM_START, SERVICE_DISABLED );
- ServiceTypes : Array[0..3] of DWord = (
- SERVICE_FILE_SYSTEM_DRIVER, SERVICE_KERNEL_DRIVER,
- SERVICE_WIN32_OWN_PROCESS, SERVICE_WIN32_SHARE_PROCESS );
- StartErrors : Array[0..3] of DWord = (
- SERVICE_ERROR_IGNORE, SERVICE_ERROR_NORMAL,
- SERVICE_ERROR_SEVERE, SERVICE_ERROR_CRITICAL);
- Function ServiceTypeToString(AType : Dword) : String;
- Function ServiceStateToString(AState : DWord) : String;
- Function ControlsAcceptedToString(AValue : DWord) : String;
- Function IsInteractiveService(AType : Dword) : Boolean;
- implementation
- ResourceString
- SErrConnected = 'Operation not permitted while connected to Service Control Manager';
- SErrNotConnected = 'Not connected to Service control manager. Cannot %s';
- SErrInvalidControlCode = 'Invalid custom control code : %d';
- SQueryServiceList = 'Query service list';
- SActive = 'Active';
- SInactive = 'Inactive';
- SStopped = 'Stopped';
- SStartPending = 'Start pending';
- SStopPending = 'Stop pending';
- SRunning = 'Running';
- SContinuePending = 'Continue pending';
- SPausePending = 'Pause pending';
- SPaused = 'Paused';
- SUnknownState = 'Unknown State (%d)';
- SUnknownType = 'Unknown type (%d)';
- SStop = 'Stop';
- SPauseContinue = 'Pause/continue';
- SShutDown = 'Shutdown';
- SDeviceDriver = 'Device driver';
- SFileSystemDriver = 'Filesystem driver';
- SAdapter = 'Adapter';
- SRecognizer = 'Recognizer';
- SService = 'Service';
- SSHaredService = 'Service (shared)';
- SErrServiceNotFound = 'Service "%s" not found.';
- { TServiceManager }
- {$ifdef ver130}
- Type
- PPChar = ^PChar;
- PCharArray = Array[Word] of PChar;
- PPCharArray = ^PCharArray;
- Procedure RaiseLastOSError;
- begin
- RaiseLastWin32Error;
- end;
- {$endif}
- procedure TServiceManager.CheckConnected(Msg: String);
- begin
- If Not Connected then
- SMError(Format(SErrNotConnected,[Msg]));
- end;
- procedure TServiceManager.ClearServices;
- begin
- FServices.Clear;
- end;
- procedure TServiceManager.Connect;
- Var
- P : PChar;
- begin
- If (FHandle=0) then
- begin
- P:=Nil;
- If (MachineName<>'') then
- P:=PChar(MachineName);
- FHandle:=OpenSCManager(P,Nil,FAccess);
- If (FHandle=0) then
- RaiseLastOSError;
- DoAfterConnect;
- If RefreshOnConnect then
- Refresh;
- end;
- end;
- constructor TServiceManager.Create(AOwner: TComponent);
- begin
- inherited;
- FServices:=TServiceEntries.Create(Self,TServiceEntry);
- FAccess:=SC_MANAGER_ALL_ACCESS;
- end;
- destructor TServiceManager.Destroy;
- begin
- FServices.Free;
- Inherited;
- end;
- procedure TServiceManager.Disconnect;
- begin
- IF (FHandle<>0) then
- begin
- DoBeforeDisConnect;
- CloseServiceHandle(FHandle);
- FHandle:=0;
- end;
- end;
- function TServiceManager.GetConnected: Boolean;
- begin
- Result:=(Handle<>0);
- end;
- procedure TServiceManager.Refresh;
- Var
- BytesNeeded,
- ServicesReturned,
- ResumeHandle : DWord;
- Info,P : PEnumServiceStatus;
- E : TServiceEntry;
- I : integer;
- begin
- ClearServices;
- CheckConnected(SQueryServiceList);
- BytesNeeded:=0;
- ServicesReturned:=0;
- ResumeHandle:=0;
- Info:=Nil;
- EnumServicesStatus(FHandle,SERVICE_WIN32,SERVICE_STATE_ALL,Info,0,
- BytesNeeded,ServicesReturned,Resumehandle);
- if (GetLastError<>ERROR_MORE_DATA) then
- RaiseLastOSError;
- Getmem(Info,BytesNeeded);
- Try
- P:=Info;
- If Not EnumServicesStatus(FHandle,SERVICE_WIN32,SERVICE_STATE_ALL,Info,BytesNeeded,
- BytesNeeded,ServicesReturned,Resumehandle) then
- RaiseLastOSError;
- For I:=1 to Servicesreturned do
- begin
- E:=FServices.Add as TServiceEntry;
- With E,P^ do
- begin
- FServiceName:=StrPas(lpServiceName);
- FDisplayName:=StrPas(lpDisplayName);
- SetStatusFields(ServiceStatus);
- end;
- PChar(P):=Pchar(P)+SizeOf(TEnumServiceStatus);
- end;
- Finally
- FreeMem(Info);
- end;
- DoAfterRefresh;
- end;
- procedure TServiceManager.SetConnected(const Value: Boolean);
- begin
- If (([csLoading,csdesigning] * ComponentState)<>[]) then
- FReconnect:=Value
- else
- If Value<>GetConnected then
- If Value then
- Connect
- Else
- Disconnect;
- end;
- procedure TServiceManager.Loaded;
- begin
- Inherited;
- If FReconnect then
- Connect;
- end;
- procedure TServiceManager.SetMachineName(const Value: string);
- begin
- If Connected then
- SMError(SErrConnected);
- FMachineName := Value;
- end;
- procedure TServiceManager.SMError(Msg: String);
- begin
- raise EServiceManager.Create(Msg);
- end;
- Function ServiceTypeToString(AType : Dword) : String;
- begin
- Case (AType and $FF) of
- SERVICE_KERNEL_DRIVER : Result:=SDeviceDriver;
- SERVICE_FILE_SYSTEM_DRIVER : Result:=SFileSystemDriver;
- SERVICE_ADAPTER : Result:=SAdapter;
- SERVICE_RECOGNIZER_DRIVER : Result:=SRecognizer;
- SERVICE_WIN32_OWN_PROCESS : Result:=SService;
- SERVICE_WIN32_SHARE_PROCESS : Result:=SSHaredService;
- else
- Result:=Format(SUnknownType,[AType]);
- end;
- end;
- Function IsInteractiveService(AType : Dword) : Boolean;
- begin
- Result:=(Atype and SERVICE_INTERACTIVE_PROCESS)<>0;
- end;
- Function ServiceStateToString(AState : Dword) : String;
- begin
- Case AState of
- SERVICE_STOPPED : Result:=SStopped;
- SERVICE_START_PENDING : Result:=SStartPending;
- SERVICE_STOP_PENDING : Result:=SStopPending;
- SERVICE_RUNNING : Result:=SRunning;
- SERVICE_CONTINUE_PENDING : Result:=SContinuePending;
- SERVICE_PAUSE_PENDING : Result:=SPausePending;
- SERVICE_PAUSED : Result:=SPaused;
- else
- Result:=Format(SUnknownState,[AState]);
- end;
- end;
- Function ControlsAcceptedToString(AValue : DWord) : String;
- Procedure AddToResult(S : String);
- begin
- If (Result='') then
- Result:=S
- else
- Result:=Result+','+S
- end;
- begin
- Result:='';
- If (AValue and SERVICE_ACCEPT_STOP)<>0 then
- AddToResult(SStop);
- If (AValue and SERVICE_ACCEPT_PAUSE_CONTINUE)<>0 then
- AddToResult(SPauseContinue);
- If (AValue and SERVICE_ACCEPT_SHUTDOWN)<>0 then
- AddToResult(SShutDown)
- end;
- procedure TServiceManager.DoAfterConnect;
- begin
- If Assigned(FAfterConnect) then
- FAfterConnect(Self);
- end;
- procedure TServiceManager.DoAfterRefresh;
- begin
- If Assigned(FAfterRefresh) then
- FAfterRefresh(Self);
- end;
- procedure TServiceManager.DoBeforeDisConnect;
- begin
- If Assigned(FBeforeDisconnect) then
- FBeforeDisconnect(Self);
- end;
- Function AllocDependencyList (Const S : String) : PChar;
- Var
- I,L : Integer;
- begin
- Result:=Nil;
- If (S<>'') then
- begin
- // Double Null terminated list of null-terminated strings.
- L:=Length(S);
- GetMem(Result,L+3);
- Move(S[1],Result^,L+1); // Move terminating null as well.
- Result[L+1]:=#0;
- Result[L+2]:=#0;
- For I:=0 to L-1 do
- If Result[i]='/' then // Change / to #0.
- Result[i]:=#0;
- end;
- end;
- Function TServiceManager.RegisterService(var Desc: TServiceDescriptor) : Thandle;
- Var
- PDep,PLO,PUser,PPWd : PChar; // We need Nil for some things.
- N,D : String;
- ReturnTag : DWord;
- begin
- With Desc do
- begin
- N:=Name;
- D:=DisplayName;
- If (LoadOrderGroup='') then
- PLO:=Nil
- else
- PLO:=PChar(LoadOrderGroup);
- PPwd:=Nil;
- PUser:=Nil;
- If (UserName<>'') then
- begin
- PUser:=PChar(UserName);
- If (Password<>'') then
- PPWd:=PChar(Password);
- end;
- PDep:=AllocDependencyList(Dependencies);
- Try
- Result:=CreateService(Self.Handle,PChar(N),PChar(D),DesiredAccess,ServiceType,
- StartType,ErrorControl,PChar(CommandLine),PLO,Nil,
- PDep,PUser,PPwd);
- If (Result=0) then
- RaiseLastOSError;
- Finally
- If PDep<>Nil then
- FreeMem(PDep);
- end;
- end;
- end;
- procedure TServiceManager.ListDependentServices(ServiceName : String; ServiceState : DWord; List : TStrings);
- Var
- H : THandle;
- begin
- H:=OpenService(Handle,PChar(ServiceName),SERVICE_ENUMERATE_DEPENDENTS);
- try
- ListDependentServices(H,ServiceState,List);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.ListDependentServices(SHandle: THandle; ServiceState : DWord; List : TStrings);
- Var
- P,E : PEnumServiceStatus;
- I,BytesNeeded,Count : DWord;
- begin
- P:=Nil;
- List.Clear;
- // If call succeeds with size 0, then there are no dependent services...
- if Not EnumDependentServices(SHandle,ServiceState,P,0,BytesNeeded,Count) then
- begin
- If (GetLastError<>ERROR_MORE_DATA) then
- RaiseLastOSError;
- GetMem(P,BytesNeeded);
- Try
- If Not EnumDependentServices(SHandle,ServiceState,P,bytesNeeded,BytesNeeded,Count) Then
- RaiseLastOSError;
- E:=P;
- For I:=0 to Count-1 do
- begin
- List.Add(StrPas(E^.lpServiceName));
- Pchar(E):=PChar(E)+SizeOf(TEnumServiceStatus);
- end;
- Finally
- FreeMem(P);
- end;
- end;
- end;
- Procedure TServiceManager.StopService(SHandle : THandle; StopDependent : Boolean);
- Var
- I : Integer;
- List : TStrings;
- Status : TServiceStatus;
- begin
- If Not QueryServiceStatus(SHandle,Status) then
- RaiseLastOSError;
- If Not (Status.dwCurrentState=SERVICE_STOPPED) then
- begin
- If StopDependent then
- begin
- List:=TStringList.Create;
- Try
- ListDependentServices(SHandle,SERVICE_ACTIVE,List);
- For I:=0 to List.Count-1 do
- StopService(List[i],False); // Do not recurse !!
- Finally
- List.Free;
- end;
- end;
- If Not ControlService(SHandle,SERVICE_CONTROL_STOP,Status) then
- RaiseLastOSError;
- end;
- end;
- Procedure TServiceManager.StopService(ServiceName : String; StopDependent : Boolean);
- Var
- H : THandle;
- A : DWORD;
- begin
- A:=SERVICE_STOP or SERVICE_QUERY_STATUS;
- If StopDependent then
- A:=A or SERVICE_ENUMERATE_DEPENDENTS;
- H:=OpenService(Handle,PChar(ServiceName),A);
- Try
- StopService(H,StopDependent);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- Function TServiceManager.GetServiceHandle(ServiceName : String; SAccess : DWord) : THandle;
- begin
- Result:=OpenService(Handle,PChar(ServiceName),SAccess);
- If (Result=0) then
- RaiseLastOSError;
- end;
- procedure TServiceManager.UnregisterService(ServiceName: String);
- Var
- H : THandle;
- Status : TServiceStatus;
- begin
- StopService(ServiceName,True);
- H:=GetServiceHandle(ServiceName,SERVICE_STOP or SERVICE_QUERY_STATUS or SERVICE_DELETE);
- Try
- If Not DeleteService(H) then
- RaiseLastOSError;
- Finally
- CloseServiceHandle(H);
- end;
- end;
- Procedure TServiceManager.PauseService(SHandle : THandle);
- Var
- Status : TServiceStatus;
- begin
- If Not ControlService(SHandle,SERVICE_CONTROL_PAUSE,Status) then
- RaiseLastOSError;
- end;
- Procedure TServiceManager.PauseService(ServiceName : String);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_PAUSE_CONTINUE);
- Try
- PauseService(H);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- Procedure TServiceManager.ContinueService(SHandle : THandle);
- Var
- Status : TServiceStatus;
- begin
- If Not ControlService(SHandle,SERVICE_CONTROL_CONTINUE,Status) then
- RaiseLastOSError;
- end;
- Procedure TServiceManager.ContinueService(ServiceName : String);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_PAUSE_CONTINUE);
- Try
- ContinueService(H);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- Function StringsToPCharList(List : TStrings) : PPChar;
- Var
- I : Integer;
- S : String;
- begin
- I:=(List.Count)+1;
- GetMem(Result,I*sizeOf(PChar));
- PPCharArray(Result)^[List.Count]:=Nil;
- For I:=0 to List.Count-1 do
- begin
- S:=List[i];
- PPCharArray(Result)^[i]:=StrNew(PChar(S));
- end;
- end;
- Procedure FreePCharList(List : PPChar);
- Var
- I : integer;
- begin
- I:=0;
- While PPChar(List)[i]<>Nil do
- begin
- StrDispose(PPChar(List)[i]);
- Inc(I);
- end;
- FreeMem(List);
- end;
- Procedure TServiceManager.StartService(SHandle : THandle; Args : TStrings);
- Var
- Argc : DWord;
- PArgs : PPchar;
- begin
- If (Args=Nil) or (Args.Count>0) then
- begin
- Argc:=0;
- Pargs:=Nil;
- end
- else
- begin
- ArgC:=Args.Count;
- Pargs:=StringsToPcharList(Args);
- end;
- Try
- If not jwawinsvc.StartService(SHandle,Argc,PArgs^) then
- RaiseLastOSError;
- Finally
- If (PArgs<>Nil) then
- FreePCharList(PArgs);
- end;
- end;
- Procedure TServiceManager.StartService(ServiceName : String; Args : TStrings);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_START);
- Try
- StartService(H,Args);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- Procedure TServiceManager.LockServiceDatabase;
- begin
- FDBLock:=jwawinsvc.LockServiceDatabase(Handle);
- If FDBLock=Nil then
- RaiseLastOSError;
- end;
- procedure TServiceManager.UnlockServiceDatabase;
- begin
- If (FDBLock<>Nil) then
- begin
- Try
- If Not jwawinsvc.UnLockServiceDatabase(FDBLock) then
- RaiseLastOSError;
- Finally
- FDBLock:=Nil;
- end;
- end;
- end;
- procedure TServiceManager.QueryServiceConfig(SHandle : THandle; Var Config : TServiceDescriptor);
- Var
- SvcCfg : PQueryServiceConfig;
- BytesNeeded : DWord;
- begin
- jwawinsvc.QueryServiceConfig(SHandle,Nil,0,BytesNeeded);
- If (GetLastError<>ERROR_INSUFFICIENT_BUFFER) then
- RaiseLastOSError;
- GetMem(SvcCfg,BytesNeeded);
- Try
- If Not jwawinsvc.QueryServiceConfig(SHandle,SvcCfg,BytesNeeded,BytesNeeded) then
- RaiseLastOSError;
- With config,SvcCfg^ do
- begin
- Password:='';
- Name:='';
- DesiredAccess:=0;
- ErrorControl:=dwErrorControl;
- ServiceType:=dwServiceType;
- StartType:=dwStartType;
- TagID:=dwTagID;
- CommandLine:=lpBinaryPathName;
- LoadOrderGroup:=lpLoadOrderGroup;
- Dependencies:=lpDependencies;
- UserName:=lpServiceStartName;
- DisplayName:=lpDisplayName;
- end;
- Finally
- FreeMem(SvcCfg,BytesNeeded);
- end;
- end;
- procedure TServiceManager.QueryServiceConfig(ServiceName : String; Var Config : TServiceDescriptor);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_QUERY_CONFIG);
- Try
- QueryServiceConfig(H,Config);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.SetStartupType(ServiceName : String; StartupType : DWord);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_CHANGE_CONFIG);
- Try
- SetStartupType(H,StartupType);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.SetStartupType(SHandle : THandle; StartupType: DWord);
- Const
- SNC = SERVICE_NO_CHANGE; // Shortcut
- begin
- If Not ChangeServiceConfig(SHandle,SNC,StartupType,SNC,Nil,Nil,Nil,Nil,Nil,Nil,Nil) then
- RaiseLastOSError;
- end;
- procedure TServiceManager.ConfigService(SHandle : THandle ; Config : TServiceDescriptor);
- Function SToPchar(Var S : String) : PChar;
- begin
- If (S='') then
- Result:=Nil
- else
- Result:=PChar(S);
- end;
- Var
- PDep,PLO,PUser,PPWd,PCmd,PDisp : PChar; // We need Nil for some things.
- D : String;
- ReturnTag : DWord;
- begin
- With Config do
- begin
- PCmd:=SToPChar(CommandLine);
- D:=DisplayName;
- PDisp:=StoPChar(D);
- PLO:=SToPChar(LoadOrderGroup);
- PUser:=SToPChar(UserName);
- PPwd:=SToPchar(Password);
- PDep:=AllocDependencyList(Dependencies);
- Try
- If Not ChangeServiceConfig(SHandle,ServiceType,StartType,ErrorControl,
- PCmd,PLO,Nil,PDep,PUser,PPwd,PDisp) then
- RaiseLastOSError;
- Finally
- If PDep<>Nil then
- FreeMem(PDep);
- end;
- end;
- end;
- procedure TServiceManager.GetServiceStatus(SHandle : THandle; Var Status: TServiceStatus);
- begin
- If Not QueryServiceStatus(SHandle,Status) then
- RaiseLastOSError;
- end;
- procedure TServiceManager.GetServiceStatus(ServiceName : String; Var Status: TServiceStatus);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_QUERY_STATUS);
- Try
- GetServiceStatus(H,Status);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.RefreshServiceStatus(ServiceName : String);
- Var
- Status : TServiceStatus;
- SE : TServiceEntry;
- begin
- SE:=Services.ServiceByName(ServiceName);
- GetServiceStatus(ServiceName,Status);
- SE.SetStatusFields(Status);
- end;
- procedure TServiceManager.ConfigService(ServiceName : String; Config : TServiceDescriptor);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_CHANGE_CONFIG);
- Try
- ConfigService(H,Config);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.CustomControlService(ServiceName: String; ControlCode: DWord);
- Var
- H : THandle;
- begin
- H:=GetServiceHandle(ServiceName,SERVICE_USER_DEFINED_CONTROL);
- Try
- CustomControlService(H,ControlCode);
- Finally
- CloseServiceHandle(H);
- end;
- end;
- procedure TServiceManager.CustomControlService(Shandle: THandle;
- ControlCode: DWord);
- Var
- Status : TServiceStatus;
- begin
- If (ControlCode<128) or (ControlCode>255) then
- Raise EServiceManager.CreateFmt(SErrInvalidControlCode,[ControlCode]);
- If Not ControlService(SHandle,ControlCode,Status) then
- RaiseLastOSError;
- end;
- { TServiceEntries }
- function TServiceEntries.FindService(ServiceName: String): TServiceEntry;
- Var
- I : Integer;
- begin
- Result:=Nil;
- I:=Count-1;
- While (I>=0) and (Result=Nil) do
- If CompareText(Items[i].ServiceName,ServiceName)=0 then
- Result:=Items[i]
- else
- Dec(I);
- end;
- function TServiceEntries.GetService(Index: Integer): TServiceEntry;
- begin
- Result:=inherited Items[Index] as TServiceEntry;
- end;
- function TServiceEntries.ServiceByName(ServiceName: String): TServiceEntry;
- begin
- Result:=FindService(ServiceName);
- If Result=Nil then
- Raise EServiceManager.CreateFmt(SErrServiceNotFound,[ServiceName]);
- end;
- { TServiceEntry }
- procedure TServiceEntry.SetStatusFields(const Status: TServiceStatus);
- begin
- With Status do
- begin
- FServiceType:=dwServiceType;
- FCurrentState:=dwCurrentState;
- FControlsAccepted:=dwControlsAccepted;
- FWin32ExitCode:=dwWin32ExitCode;
- FServiceSpecificExitCode:=dwServiceSpecificExitCode;
- FCheckPoint:=dwCheckPoint;
- FWaitHint:=dwWaitHint;
- end;
- end;
- end.
|