unit Un_ServiceTools;
interface
uses
Windows, SysUtils, Classes, SvcMgr, WinSvc, TLHelp32, PsApi, StrUtils;
type
TServiceToolAction = (saStart, saStop, saPause, saContinue);
TServiceToolError = (seNoError, seUnknownError,
seManagerAccesDenied, seManagerDbDoesNotExists, seManagerInvalidParameter,
seServiceNoAcces, seServiceAccesDenied, seServiceInvalidHandle, seServiceInvalidName, seServiceDoesNotExist, seServiceTimeout,
seServiceCannotAcceptCtrl, seServiceNotActive, seServiceRequestTimeout, seServiceAlreadyRunning, seServiceDatabaseLocked, seServiceDependencyDeleted, seServiceDependencyFail,
seServiceDisabled, seServiceLogonFailed, seServiceMarkedForDelete, seServiceNoThread, seServiceDependentServicesRunning, seServiceInvalidServiceControl, seServicePathNotFound);
TServiceToolState = (ssUnknown, ssStopped, ssStartPending, ssStopPending, ssRunning, ssContinuePending, ssPausePending, ssPaused);
TServiceTools =
class(TObject)
private
ManagerHandle,
ServiceHandle : THandle;
LastServicaName :
String;
function OpenManager: TServiceToolError;
function OpenService(
const ServiceName:
String): TServiceToolError;
procedure CloseService;
protected
public
constructor Create;
destructor Destroy;
override;
procedure CloseManager;
function GetServiceState(
const ServiceName:
String;
OUT State:TServiceToolState): TServiceToolError;
function ControllService(
const ServiceName:
String;
const Action:TServiceToolAction): TServiceToolError;
end;
// TServiceTools
function GetServiceErrorName(Error:TServiceToolError):
String;
function CanConfigService(ServiceName:
String):Boolean;
procedure ServiceTools_Initialize;
procedure ServiceTools_CreateForm(InstanceClass: TComponentClass;
var Reference);
procedure ServiceTools_Run;
function ServiceTools_StartAsService:Boolean;
implementation
function GetProcessImageFileName(hProcess: tHANDLE;lpImageFileName: LPTSTR;nSize: DWORD): DWORD;
stdcall;
external '
psapi.dll'
name '
GetProcessImageFileName'+
{$IFDEF UNICODE}'
W'
{$ELSE}'
A'
{$ENDIF};
function GetServiceErrorName(Error:TServiceToolError):
String;
begin
case Error
of
seNoError : Result := '
No Error';
seManagerAccesDenied : Result := '
Manager: Acces Denied';
seManagerDbDoesNotExists : Result := '
Manager: Database doesn''
t exists';
seManagerInvalidParameter : Result := '
Manager: Invalid Parameter';
seServiceNoAcces : Result := '
Service: The specified service control manager database handle does not have access to the service';
seServiceAccesDenied : Result := '
Service: The specified handle was not opened with the necessary access';
seServiceInvalidHandle : Result := '
Service: The specified handle is invalid';
seServiceInvalidName : Result := '
Service: The specified service name is invalid';
seServiceDoesNotExist : Result := '
Service: The specified service does not exist';
seServiceTimeout : Result := '
Service: Getting Service State takes to long';
seServiceCannotAcceptCtrl : Result := '
Service: The requested control code cannot be sent to the service';
seServiceNotActive : Result := '
Service: The service has not been started';
seServiceRequestTimeout : Result := '
Service: The service did not respond to the start request in a timely fashion';
seServiceAlreadyRunning : Result := '
Service: An instance of the service is already running';
seServiceDatabaseLocked : Result := '
Service: The database is locked';
seServiceDependencyDeleted : Result := '
Service: The service depends on a service that does not exist or has been marked for deletion';
seServiceDependencyFail : Result := '
Service: The service depends on another service that has failed to start';
seServiceDisabled : Result := '
Service: The service has been disabled';
seServiceLogonFailed : Result := '
Service: The service could not be logged on';
seServiceMarkedForDelete : Result := '
Service: The service has been marked for deletion';
seServiceNoThread : Result := '
Service: A thread could not be created for the Win32 service';
seServiceDependentServicesRunning : Result := '
Service: The service cannot be stopped because other running services are dependent on it';
seServiceInvalidServiceControl : Result := '
Service: The requested control code is not valid, or it is unacceptable to the service';
seServicePathNotFound : Result := '
Service: The service binary file could not be found';
else Result := '
Unknown Error';
end;
// case Error
end;
function CanConfigService(ServiceName:
String): Boolean;
var ServiceControl : TServiceTools;
ServiceState : TServiceToolState;
ServiceError : TServiceToolError;
begin
Result := False;
ServiceControl := TServiceTools.Create;
try
ServiceError := ServiceControl.GetServiceState(ServiceName,ServiceState);
Result :=
NOT (ServiceError
in [seUnknownError,seManagerAccesDenied,seManagerDbDoesNotExists,seManagerInvalidParameter]);
finally
ServiceControl.Free;
end;
end;
procedure ServiceTools_Initialize;
begin
Application.Initialize;
end;
procedure ServiceTools_CreateForm(InstanceClass: TComponentClass;
var Reference);
begin
Application.CreateForm(InstanceClass, Reference);
end;
procedure ServiceTools_Run;
begin
Application.Run;
end;
function ServiceTools_StartAsService:Boolean;
{+------------------------------------------------------------------------------}
{|} function DevicePathToWin32Path(Path:
String):
String;
{|} var Drive : Char;
{|} Text :
String;
{|} Count : Integer;
{|} begin
{|} Count := PosEx('
\', Path, 2);
{|} Count := PosEx('
\', Path, Count+1);
{|}
{|} Result := Copy(Path, Count, Length(Path));
{|} Delete(Path, Count, Length(Path));
{|} for Drive := '
A'
to '
Z'
do
{|} begin
{|} SetLength(Text, 1000);
{|} if QueryDosDevice(PChar(
String(Drive)+'
:'), PChar(Text), Length(Text)) <> 0
then
{|} begin
{|} Text := PChar(Text);
{|} if SameText(Path, Text)
then
{|} begin
{|} Result := Drive+'
:'+Result;
{|} Exit;
{|} end;
{|} end;
{|} end;
{|} Result := '
';
{|} end;
{+------------------------------------------------------------------------------}
var LocalPrId,
ServicePrId : DWord;
SnapshotHandle,
ProcessHandle : THandle;
ProcessEntry32 : TProcessEntry32;
FileName :
String;
begin
Result := False;
// 'INSTALL' oder 'UNINSTALL' im aufruf parameter => Sofort als Dienst weitermachen
if FindCmdLineSwitch('
INSTALL')
OR FindCmdLineSwitch('
UNINSTALL')
then
Exit(True);
// Alle Prozesse durchgehen
LocalPrId := GetCurrentProcessId;
ServicePrId := 0;
SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
ProcessEntry32.dwSize := SizeOf(ProcessEntry32);
try
if Process32First(SnapshotHandle, ProcessEntry32)
then
repeat
FileName := '
';
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION
OR PROCESS_VM_READ, False, ProcessEntry32.th32ProcessID);
try
if ProcessHandle <> 0
then
begin
SetLength(FileName, MAX_PATH);
if GetProcessImageFileName(ProcessHandle,PChar(FileName), MAX_PATH) <> 0
then FileName := DevicePathToWin32Path(StrPas(PChar(FileName)))
else FileName := '
';
end;
finally
CloseHandle(ProcessHandle);
end;
// Wenn der Service Controller gefunden wurde PrId Merken
if ContainsText(FileName,'
System32\services.exe')
then
ServicePrId := ProcessEntry32.th32ProcessID;
// Aktuellen Prozess gefunden => Überprüfen ob der Service Controller gefunden wurde und dieser als Parent eingetragen ist
if (ProcessEntry32.th32ProcessID = LocalPrId)
then
Exit((ServicePrId <> 0)
AND (ServicePrId = ProcessEntry32.th32ParentProcessID));
until NOT Process32Next(SnapshotHandle, ProcessEntry32);
finally
CloseHandle(SnapshotHandle);
end;
end;
{ TServiceTools }
constructor TServiceTools.Create;
begin
inherited Create;
Self.LastServicaName := '
';
Self.ManagerHandle := 0;
Self.ServiceHandle := 0;
end;
destructor TServiceTools.Destroy;
begin
CloseService;
CloseManager;
inherited Destroy;
end;
function TServiceTools.OpenManager: TServiceToolError;
begin
if ManagerHandle <> 0
then
Exit(seNoError);
// Bereits geöffnet
ManagerHandle := WinSvc.OpenScManager(
nil,
nil, GENERIC_READ
or GENERIC_EXECUTE);
if ManagerHandle <> 0
then begin
Result := seNoError;
end
else begin
case GetLastError
of
ERROR_ACCESS_DENIED : Result := seManagerAccesDenied;
ERROR_DATABASE_DOES_NOT_EXIST : Result := seManagerDbDoesNotExists;
ERROR_INVALID_PARAMETER : Result := seManagerInvalidParameter;
else Result := seUnknownError;
end;
// case
end;
end;
procedure TServiceTools.CloseManager;
begin
CloseService;
if ManagerHandle <> 0
then
begin
CloseServiceHandle(ManagerHandle);
ManagerHandle := 0;
end;
end;
function TServiceTools.OpenService(
const ServiceName:
String): TServiceToolError;
begin
Result := OpenManager;
if Result = seNoError
then
begin
if ServiceHandle <> 0
then
begin // ServiceHandle ist geöffnet
if SameText(ServiceName,LastServicaName)
// Service Name unterscheidet sich vom letzten aufruf =>
then Exit(seNoError)
// Bereits geöffnet
else CloseService;
// Schließen
end;
LastServicaName := '
';
ServiceHandle := WinSvc.OpenService(ManagerHandle, PChar(ServiceName), SERVICE_ALL_ACCESS);
if ServiceHandle <> 0
then begin
Result := seNoError;
LastServicaName := ServiceName;
end
else begin
case GetLastError
of
ERROR_ACCESS_DENIED : Result := seServiceNoAcces;
ERROR_INVALID_HANDLE : Result := seServiceInvalidHandle;
ERROR_INVALID_NAME : Result := seServiceInvalidName;
ERROR_SERVICE_DOES_NOT_EXIST : Result := seServiceDoesNotExist;
else Result := seUnknownError;
end;
// case
end;
end;
end;
procedure TServiceTools.CloseService;
begin
if ServiceHandle <> 0
then
begin
CloseServiceHandle(ServiceHandle);
ServiceHandle := 0;
end;
end;
function TServiceTools.GetServiceState(
const ServiceName:
String;
out State: TServiceToolState): TServiceToolError;
var ServiceStatus : TServiceStatus;
begin
Result := OpenManager;
if Result = seNoError
then
begin
Result := OpenService(ServiceName);
if Result = seNoError
then
begin
if WinSvc.QueryServiceStatus(ServiceHandle, ServiceStatus)
then begin
Result := seNoError;
case ServiceStatus.dwCurrentState
of
SERVICE_STOPPED : State := ssStopped;
SERVICE_START_PENDING : State := ssStartPending;
SERVICE_STOP_PENDING : State := ssStopPending;
SERVICE_RUNNING : State := ssRunning;
SERVICE_CONTINUE_PENDING : State := ssContinuePending;
SERVICE_PAUSE_PENDING : State := ssPausePending;
SERVICE_PAUSED : State := ssPaused;
else State := ssUnknown;
end;
// case
end
else begin
case GetLastError
of
ERROR_ACCESS_DENIED : Result := seServiceAccesDenied;
ERROR_INVALID_HANDLE : Result := seServiceInvalidHandle;
else Result := seUnknownError;
end;
// case
end;
end;
// Service Opend
end;
// Manager Opend
end;
function TServiceTools.ControllService(
const ServiceName:
String;
const Action: TServiceToolAction): TServiceToolError;
const WaitFor :
array [TServiceToolAction]
of DWORD = (SERVICE_RUNNING, SERVICE_STOPPED, SERVICE_PAUSED, SERVICE_RUNNING);
var Args : PChar;
ServiceStatus : TServiceStatus;
ActionResult : Boolean;
Timeout : Byte;
begin
Result := OpenManager;
if Result = seNoError
then
begin
Result := OpenService(ServiceName);
if Result = seNoError
then
begin
case Action
of
saStart : ActionResult := WinSvc.StartService(ServiceHandle, 0, Args);
saStop : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_STOP , ServiceStatus);
saPause : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_PAUSE , ServiceStatus);
saContinue : ActionResult := WinSvc.ControlService(ServiceHandle, SERVICE_CONTROL_CONTINUE, ServiceStatus);
else ActionResult := False;
end;
//case
if ActionResult
then begin
Result := seNoError;
Timeout := 0;
while (Timeout < 10)
AND QueryServiceStatus(ServiceHandle,ServiceStatus)
AND (WaitFor[Action] <> ServiceStatus.dwCurrentState)
do
begin
Sleep(1000);
// 1 sec warten
Inc(Timeout);
end;
if Timeout >= 10
then
Exit(seServiceTimeout);
QueryServiceStatus(ServiceHandle,ServiceStatus);
case Action
of
saStart :
if ServiceStatus.dwCurrentState <> SERVICE_RUNNING
then
Exit(seUnknownError);
saStop :
if ServiceStatus.dwCurrentState <> SERVICE_STOPPED
then
Exit(seUnknownError);
end;
end
else begin
case GetLastError
of
ERROR_ACCESS_DENIED : Result := seServiceAccesDenied;
ERROR_SERVICE_CANNOT_ACCEPT_CTRL : Result := seServiceCannotAcceptCtrl;
ERROR_SERVICE_NOT_ACTIVE : Result := seServiceNotActive;
ERROR_SERVICE_REQUEST_TIMEOUT : Result := seServiceRequestTimeout;
ERROR_SERVICE_ALREADY_RUNNING : Result := seServiceAlreadyRunning;
ERROR_SERVICE_DATABASE_LOCKED : Result := seServiceDatabaseLocked;
ERROR_SERVICE_DEPENDENCY_DELETED : Result := seServiceDependencyDeleted;
ERROR_SERVICE_DEPENDENCY_FAIL : Result := seServiceDependencyFail;
ERROR_SERVICE_DISABLED : Result := seServiceDisabled;
ERROR_SERVICE_LOGON_FAILED : Result := seServiceLogonFailed;
ERROR_SERVICE_MARKED_FOR_DELETE : Result := seServiceMarkedForDelete;
ERROR_SERVICE_NO_THREAD : Result := seServiceNoThread;
ERROR_DEPENDENT_SERVICES_RUNNING : Result := seServiceDependentServicesRunning;
ERROR_INVALID_SERVICE_CONTROL : Result := seServiceInvalidServiceControl;
ERROR_INVALID_HANDLE : Result := seServiceInvalidHandle;
ERROR_PATH_NOT_FOUND : Result := seServiceAccesDenied;
else Result := seServicePathNotFound;
end;
// case GetLastError
end;
end;
// Service Opend
end;
// Manager Opend
end;
end.