Ver Mensaje Individual
  #10  
Antiguo 20-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
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
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
   Machine = '\\MachineName'; // Machine = '\\127.0.0.1';
   Service = 'Active@ Disk Monitor';
   // Service = 'WinDefend';
   // Service = 'OO DiskImage';
   // Service = 'PDEngine';
   // Service = 'PDAgent';

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.

Última edición por nlsgarcia fecha: 20-05-2014 a las 21:10:59.
Responder Con Cita