Club Delphi,
Revisen este código:
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinSvc, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
Machine = '\\MachineName'; Service = 'Active@ Disk Monitor';
function ServiceStart(Machine, Service: String) : Integer;
const
TimeLimit : Word = 60000;
var
OpenScm, OpenSvr : SC_Handle;
SrvSts : TServiceStatus;
SrvArgVec : PChar;
WaitTime : Word;
StartTickCount, StopTickCount : Word;
begin
try
OpenScm := OpenSCManager(PChar(Machine), SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if (OpenScm > 0) then
begin
OpenSvr := OpenService(OpenScm, PChar(Service),
SERVICE_START or
SERVICE_QUERY_STATUS);
if (OpenSvr > 0) and (QueryServiceStatus(OpenSvr, SrvSts)) then
begin
if (StartService(OpenSvr, 0, SrvArgVec)) then
begin
StartTickCount := GetTickCount;
while QueryServiceStatus(OpenSvr, SrvSts) do
begin
WaitTime := SrvSts.dwWaitHint div 10;
if (WaitTime < 1000) then
WaitTime := 1000
else
if (WaitTime > 10000) then
WaitTime := 10000;
Sleep(SrvSts.dwWaitHint);
StopTickCount := GetTickCount;
if (StopTickCount - StartTickCount) > TimeLimit then
Break;
case SrvSts.dwCurrentState of
SERVICE_START_PENDING : Continue;
SERVICE_RUNNING : Break;
SERVICE_STOP_PENDING : Break;
SERVICE_STOPPED : Break;
end;
if (SrvSts.dwCheckPoint = 0) then
Break;
end;
end;
CloseServiceHandle(OpenSvr);
end;
CloseServiceHandle(OpenScm);
end;
Result := SrvSts.dwCurrentState;
except
SysErrorMessage(GetLastError);
Result := GetLastError;
end;
end;
function StopDependentServices(OpenScm, OpenSvr : SC_Handle): Boolean;
const
TimeLimit : Word = 60000;
var
OpenSvrDep : SC_Handle;
pStatus, pResult : PEnumServiceStatus;
SrvSts : TServiceStatus;
cbSize, cbSizeNeeded, cbServicesReturned : LongWord;
i: integer;
WaitTime : Word;
StartTickCount, StopTickCount : Word;
begin
Result := False;
pStatus := nil;
try
EnumDependentServices(OpenSvr, SERVICE_ACTIVE, pStatus^, 0,
cbSizeNeeded, cbServicesReturned);
GetMem(pStatus,cbSizeNeeded);
ZeroMemory(pStatus, cbSizeNeeded);
if EnumDependentServices(OpenSvr, SERVICE_ACTIVE, pStatus^,
cbSizeNeeded, cbSizeNeeded, cbServicesReturned) then
begin
pResult := pStatus;
for i := 0 to cbServicesReturned - 1 do
begin
OpenSvrDep := OpenService(OpenScm, PChar(pResult^.lpServiceName),
SERVICE_STOP or
SERVICE_QUERY_STATUS or
SERVICE_ENUMERATE_DEPENDENTS);
if QueryServiceStatus(OpenSvrDep, SrvSts) then
if ControlService(OpenSvrDep, SERVICE_CONTROL_STOP, SrvSts) then
begin
StartTickCount := GetTickCount;
while QueryServiceStatus(OpenSvrDep, SrvSts) do
begin
WaitTime := SrvSts.dwWaitHint div 10;
if (WaitTime < 1000) then
WaitTime := 1000
else
if (WaitTime > 10000) then
WaitTime := 10000;
Sleep(SrvSts.dwWaitHint);
StopTickCount := GetTickCount;
if (StopTickCount - StartTickCount) > TimeLimit then
Break;
case SrvSts.dwCurrentState of
SERVICE_STOP_PENDING : Continue;
SERVICE_STOPPED : Break;
end;
if (SrvSts.dwCheckPoint = 0) then
Break;
end;
end;
Inc(pResult)
end;
Result := True;
end
except
SysErrorMessage(GetLastError);
Result := False;
end;
FreeMem(pStatus);
end;
function ServiceStop(Machine, Service: String) : Integer;
const
TimeLimit : Word = 60000;
var
OpenScm, OpenSvr : SC_Handle;
SrvSts : TServiceStatus;
WaitTime : Word;
StartTickCount, StopTickCount : Word;
begin
OpenScm := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT or
SERVICE_ENUMERATE_DEPENDENTS);
if (OpenScm > 0) then
begin
OpenSvr := OpenService(OpenScm, PChar(Service),
SERVICE_STOP or
SERVICE_QUERY_STATUS or
SERVICE_ENUMERATE_DEPENDENTS);
if (OpenSvr > 0) and (QueryServiceStatus(OpenSvr, SrvSts)) then
begin
StopDependentServices(OpenScm, OpenSvr);
if ControlService(OpenSvr, SERVICE_CONTROL_STOP, SrvSts) then
begin
StartTickCount := GetTickCount;
while QueryServiceStatus(OpenSvr, SrvSts) do
begin
WaitTime := SrvSts.dwWaitHint div 10;
if (WaitTime < 1000) then
WaitTime := 1000
else
if (WaitTime > 10000) then
WaitTime := 10000;
Sleep(SrvSts.dwWaitHint);
StopTickCount := GetTickCount;
if (StopTickCount - StartTickCount) > TimeLimit then
Break;
case SrvSts.dwCurrentState of
SERVICE_STOP_PENDING : Continue;
SERVICE_STOPPED : Break;
end;
if (SrvSts.dwCheckPoint = 0) then
Break;
end;
end;
CloseServiceHandle(OpenSvr);
end;
CloseServiceHandle(OpenScm);
end;
Result := SrvSts.dwCurrentState;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Msg : String;
begin
case ServiceStart(Machine, Service) of
1 : Msg := 'SERVICE_STOPPED';
2 : Msg := 'SERVICE_START_PENDING';
3 : Msg := 'SERVICE_STOP_PENDING';
4 : Msg := 'SERVICE_RUNNING';
6 : Msg := 'SERVICE_PAUSE_PENDING';
7 : Msg := 'SERVICE_PAUSED';
else
Msg := 'Error de Apertura en SCM o Servicio';
end;
MessageDlg(Msg,mtInformation,[mbOK],0);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Msg : String;
begin
case ServiceStop(Machine, Service) of
1 : Msg := 'SERVICE_STOPPED';
2 : Msg := 'SERVICE_START_PENDING';
3 : Msg := 'SERVICE_STOP_PENDING';
4 : Msg := 'SERVICE_RUNNING';
6 : Msg := 'SERVICE_PAUSE_PENDING';
7 : Msg := 'SERVICE_PAUSED';
else
Msg := 'Error de Apertura en SCM o Servicio';
end;
MessageDlg(Msg,mtInformation,[mbOK],0);
end;
end.
El código anterior
es la versión 2 del código del
Msg#1 que
permite iniciar o detener un Servicio en Windows por medio de las
Service Functions APIs.
El código fue probado en Delphi 7, Delphi 2010 y Delphi XE4 (VCL 32 Bits y 64 Bits) bajo Windows 7 Professional x32 y x64, funcionando correctamente según lo esperado con los servicios de prueba utilizados tanto en 32 como 64 bits.
Nota:
1- La versión 2 verifica los posibles estatus pertinentes en la apertura (
Función ServiceStart) y cierre (
Función ServiceStop) del servicio a procesar.
2- La versión 2 cierra los servicios activos que son dependientes del servicio a finalizar por medio de la
Función StopDependentServices la cual es llamada desde la
Función ServiceStop encargada de cerrar el servicio requerido y derivados,
esto debe ser tomado en cuenta al momento de cerrar un servicio, si se obvia la
Función StopDependentServices todos los servicios dependientes fallaran al cerrar el servicio principal.
3- La versión 2 tiene
un control de TimeOut configurable para todas las funciones, en caso de producirse un Timeout en las funciones de Apertura o Cierre de un Servicio, estas devolverán
el último estatus registrado del servicio al momento del TimeOut.
Espero sea útil
Nelson.