{
======================================================================
Project : Firebird utilities
Unit : uService.pas
Purpose : Access the windows NT service manager API
Author : Achim Kalwa <delphi@achim-kalwa.de>
Compiler : Borland Delphi 5.01
----------------------------------------------------------------------
Historie:
2002-03-04, Kalwa:
- Form/Unit created
2002-03-17, Kalwa:
- BUGFIX: In DoQueryServiceStatus, DoChangeServiceConfig,
the memory allocated for PServiceConfig was never freed.
======================================================================
}
unit uService;
interface
uses
SysUtils,
Windows,
WinSvc;
type
TSvcStatus = (ssUnknown,
// enumeration of service status
ssStopped,
ssStartPending,
ssStopPending,
ssRunning,
ssContinuePending,
ssPausePending,
ssPaused,
ssError);
function GetWinSysDir :
String;
function GetServiceStatus(ServiceName :
String) : TSvcStatus;
function DoStartService(ServiceName :
string) : TSvcStatus;
function DoStopService(ServiceName :
string) : TSvcStatus;
function DoChangeServiceConfig(ServiceName :
string; Enabled, AutoStart : Boolean) : Boolean;
function DoQueryServiceConfig(ServiceName :
string;
var DisplayName :
string;
var Enabled, AutoStart : Boolean) : Boolean;
implementation
uses
Controls,
Forms;
function GetWinSysDir :
String;
var
aLen : Integer;
begin
SetLength(Result, MAX_PATH);
aLen := Windows.GetSystemDirectory(PChar(Result), MAX_PATH);
SetLength(Result, aLen);
end;
function GetServiceStatus(ServiceName :
String) : TSvcStatus;
{ retrieve status of given service }
var
dwStatus : DWord;
hService : SC_HANDLE;
hServiceManager : SC_HANDLE;
ServiceStatus : TServiceStatus;
Begin
dwStatus := 0 ;
hServiceManager := OpenSCManager(
nil,
nil, SC_MANAGER_CONNECT);
if hServiceManager > 0
then begin
hService := OpenService(hServiceManager,
pChar(ServiceName),
SERVICE_QUERY_STATUS);
if hService > 0
then begin
if QueryServiceStatus(hService, ServiceStatus)
then begin
dwStatus := ServiceStatus.dwCurrentState;
end;
CloseServiceHandle(hService) ;
end;
end;
CloseServiceHandle(hServiceManager) ;
Result := TSvcStatus(dwStatus);
end;
{ GetServiceStatus }
function DoStartService(ServiceName :
string) : TSvcStatus;
{ start a installed service by name. Returns the service status }
var
hService : SC_HANDLE;
hServiceManager : SC_HANDLE;
pDummy : PChar;
Tries : Integer;
begin
Result := GetServiceStatus(ServiceName);
if Result <> ssStopped
then Exit;
Screen.Cursor := crHourGlass;
hServiceManager := OpenSCManager(
nil,
nil, SC_MANAGER_CONNECT);
if hServiceManager > 0
then begin
hService := OpenService(hServiceManager,
PChar(ServiceName),
SERVICE_START);
if hService > 0
then begin
pDummy :=
nil;
if StartService(hService, 0, pDummy)
then begin
Tries := 10;
repeat
Sleep(1000);
Result := GetServiceStatus(ServiceName);
Dec(Tries);
until (Tries = 0)
or (Result = ssRunning);
end
else begin
Result := ssError;
end;
CloseServiceHandle(hService);
end;
end;
CloseServiceHandle(hServiceManager);
Screen.Cursor := crDefault;
end;
{ DoStartService }
function DoStopService(ServiceName :
string) : TSvcStatus;
{ stop a running service by name. Returns the service status }
var
hService : SC_HANDLE;
hServiceManager : SC_HANDLE;
ServiceStatus : TServiceStatus;
Tries : Integer;
begin
Result := GetServiceStatus(ServiceName);
if Result <> ssRunning
then Exit;
Screen.Cursor := crHourGlass;
hServiceManager := OpenSCManager(
nil,
nil, SC_MANAGER_ALL_ACCESS);
if hServiceManager > 0
then begin
hService := OpenService(hServiceManager,
PChar(ServiceName),
GENERIC_EXECUTE);
if hService > 0
then begin
if ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus)
then begin
Tries := 10;
Repeat
Sleep(1000);
Dec(Tries);
Result := GetServiceStatus(ServiceName);
until (Tries = 0)
or (Result = ssStopped);
end
else
Result := ssError;
CloseServiceHandle(hService);
end;
end;
CloseServiceHandle(hServiceManager) ;
Screen.Cursor := crDefault;
end;
{ DoStopService }
function DoQueryServiceConfig(ServiceName :
string;
var DisplayName :
string;
var Enabled, AutoStart : Boolean) : Boolean;
{ retrieves information for a named service. }
var
hService : SC_HANDLE;
hServiceManager : SC_HANDLE;
BytesNeeded : DWORD;
PServiceConfig : PQueryServiceConfig;
begin
Result := False;
DisplayName := '
';
Enabled := False;
AutoStart := False;
hServiceManager := OpenSCManager(
nil,
nil, SC_MANAGER_ALL_ACCESS);
if hServiceManager > 0
then begin
hService := OpenService(hServiceManager,
PChar(ServiceName),
SERVICE_QUERY_CONFIG
or SERVICE_CHANGE_CONFIG);
if hService > 0
then begin
BytesNeeded := 0;
QueryServiceConfig(hService,
nil, 0, BytesNeeded);
GetMem(PServiceConfig, BytesNeeded);
QueryServiceConfig(hService, PServiceConfig, BytesNeeded, BytesNeeded);
DisplayName := StrPas(PServiceConfig^.lpDisplayName);
case PServiceConfig^.dwStartType
of
SERVICE_AUTO_START:
begin
Enabled := True;
AutoStart := True;
end;
SERVICE_DEMAND_START:
begin
Enabled := True;
AutoStart := False;
end;
SERVICE_DISABLED:
begin
Enabled := False;
AutoStart := False;
end;
end;
{ case }
CloseServiceHandle(hService);
FreeMem(PServiceConfig);
end;
end;
CloseServiceHandle(hServiceManager) ;
Screen.Cursor := crDefault;
end;
{ DoQueryServiceStatus }
function DoChangeServiceConfig(ServiceName :
string; Enabled, AutoStart : Boolean) : Boolean;
{ changes a service's statup configuration }
var
hService : SC_HANDLE;
hServiceManager : SC_HANDLE;
NewStartType : Integer;
DisplayName :
string;
BytesNeeded : DWORD;
PServiceConfig : PQueryServiceConfig;
begin
Result := False;
hServiceManager := OpenSCManager(
nil,
nil, SC_MANAGER_ALL_ACCESS);
if hServiceManager > 0
then begin
hService := OpenService(hServiceManager,
PChar(ServiceName),
SERVICE_QUERY_CONFIG
or SERVICE_CHANGE_CONFIG);
if hService > 0
then begin
BytesNeeded := 0;
QueryServiceConfig(hService,
nil, 0, BytesNeeded);
GetMem(PServiceConfig, BytesNeeded);
QueryServiceConfig(hService, PServiceConfig, BytesNeeded, BytesNeeded);
DisplayName := StrPas(PServiceConfig^.lpDisplayName);
if Enabled
then begin
if AutoStart
then NewStartType := SERVICE_AUTO_START
else NewStartType := SERVICE_DEMAND_START;
end
else
NewStartType := SERVICE_DISABLED;
Result := ChangeServiceConfig(
hService,
{ Handle of Service }
SERVICE_NO_CHANGE,
{ don't change service type }
NewStartType,
{ set new start type }
SERVICE_NO_CHANGE,
{ don't change ErrorControl }
nil,
{ don't change BinaryPathName }
nil,
{ don't change LoadGroupOrder }
nil,
{ don't change dwTagID }
nil,
{ don't change Dependencies }
nil,
{ don't change ServiceStartName }
nil,
{ don't change Password (if any) }
PChar(DisplayName));
{ Display name }
CloseServiceHandle(hService);
FreeMem(PServiceConfig);
end;
end;
CloseServiceHandle(hServiceManager) ;
Screen.Cursor := crDefault;
end;
{ DoChangeServiceConfig }
end.