Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 18-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
glsaavedra,

Cita:
Empezado por glsaavedra
...Delphi - XE3...Windows 7 - Home Premiun - 64 bits...El servicio en cuestión es MySQL (bien Inicio, mal Detener)...
Pregunto:

1- ¿La aplicación en cuestión donde se implementa el código del Msg #1 es VCL o FireMonkey?, ¿Esta compilada en 32 Bits o 64 Bits?.

2- ¿Cuando te refieres a mal Detener, quieres indicar que el servicio MySQL se detiene pero la función ServiceStop no finaliza?, ¿Es correcto?.

3- ¿El servicio de MySQL es de 32 o 64 bits?.

4- ¿Los servicios que inician y detienen correctamente son de 32 o 64 bits?.

5- ¿Puedes probar el iniciar y detener el servicio de MySQL en un ambiente de 32 Bits?.

Espero sea útil

Nelson.
Responder Con Cita
  #2  
Antiguo 20-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 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 20:10:59.
Responder Con Cita
  #3  
Antiguo 21-05-2014
glsaavedra glsaavedra is offline
Miembro
 
Registrado: ene 2007
Posts: 14
Poder: 0
glsaavedra Va por buen camino
Hola Nelson

Paso a responder

1 - VCL compilado en 32
2 - exacto, detiene el servicio pero la función no finaliza
3 - Probado en W7 64 con MySQL 32 y W7 32 con MySQL 32
4 - de ambos
5 - probado con igual resultado - para corroborar, le pasé el ejecutable a un amigo que tiene todo 32 y se comporta del mismo modo.

Saludos

Guillermo




Cita:
Empezado por nlsgarcia Ver Mensaje
glsaavedra,



Pregunto:

1- ¿La aplicación en cuestión donde se implementa el código del Msg #1 es VCL o FireMonkey?, ¿Esta compilada en 32 Bits o 64 Bits?.

2- ¿Cuando te refieres a mal Detener, quieres indicar que el servicio MySQL se detiene pero la función ServiceStop no finaliza?, ¿Es correcto?.

3- ¿El servicio de MySQL es de 32 o 64 bits?.

4- ¿Los servicios que inician y detienen correctamente son de 32 o 64 bits?.

5- ¿Puedes probar el iniciar y detener el servicio de MySQL en un ambiente de 32 Bits?.

Espero sea útil

Nelson.
Responder Con Cita
  #4  
Antiguo 21-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
glsaavedra,

Cita:
Empezado por glsaavedra
...Delphi - XE3...VCL compilado en 32...detiene el servicio pero la función no finaliza...Probado en W7 64 con MySQL 32 y W7 32 con MySQL 32...
La falla reportada es con la versión 1 del programa que esta en el Msg #1.

Pregunto : ¿Probastes la versión 2 del programa que esta en el Msg #10?

Nelson.

Última edición por nlsgarcia fecha: 21-05-2014 a las 02:42:04.
Responder Con Cita
  #5  
Antiguo 21-05-2014
glsaavedra glsaavedra is offline
Miembro
 
Registrado: ene 2007
Posts: 14
Poder: 0
glsaavedra Va por buen camino
Nelson

pruebo con el Msg #10 y te comento

Saludos

Guillermo

Cita:
Empezado por nlsgarcia Ver Mensaje
glsaavedra,


La falla reportada es con la versión 1 del programa que esta en el Msg #1.

Pregunto : ¿Probastes la versión 2 del programa que esta en el Msg #10?

Nelson.
Responder Con Cita
  #6  
Antiguo 21-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
glsaavedra,

Cita:
Empezado por glsaavedra
...pruebo con el Msg #10 y te comento...
Una pequeña corrección :

En las funciones ServiceStart, ServiceStop y StopDependentServices del código incluido en el Msg #10 hacer el siguiente cambio:
Código Delphi [-]
Sleep(SrvSts.dwWaitHint) cambiarlo por Sleep(WaitTime)
Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 21-05-2014 a las 16:37:00.
Responder Con Cita
  #7  
Antiguo 22-05-2014
glsaavedra glsaavedra is offline
Miembro
 
Registrado: ene 2007
Posts: 14
Poder: 0
glsaavedra Va por buen camino
Nelson

Perfecto !!!!
Todo funciona correctamente

Nuevamente gracias

Guillermo
Responder Con Cita
  #8  
Antiguo 30-05-2014
glsaavedra glsaavedra is offline
Miembro
 
Registrado: ene 2007
Posts: 14
Poder: 0
glsaavedra Va por buen camino
Hola gente ... Hola Nelson

Te molesto por una consulta, para ampliar, el tema de la "machine" donde iniciar o detener el servicio.
Hay alguna consideración especial ?
Hasta ahora solo he probado con \\127.0.0.1, pero quiero hacer pruebas con un MySQL en otra IP de la red

Saludos y gracias

Guillermo
Responder Con Cita
  #9  
Antiguo 21-05-2014
glsaavedra glsaavedra is offline
Miembro
 
Registrado: ene 2007
Posts: 14
Poder: 0
glsaavedra Va por buen camino
Nelson

probé, solo tuve que cambiar los boolean por integer de las funciones start y stop, porque si no el case daba error de compilación.

Salvado eso, el comportamiento es el mismo, inicia bien, detiene, sigue deteniendo pero no finalizando

Saludos

Guillermo

Cita:
Empezado por nlsgarcia Ver Mensaje
glsaavedra,


La falla reportada es con la versión 1 del programa que esta en el Msg #1.

Pregunto : ¿Probastes la versión 2 del programa que esta en el Msg #10?

Nelson.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Detener un servicio Windows cmfab Varios 4 09-03-2014 18:21:47
Iniciar y detener jobs!! Melissa_12 MS SQL Server 3 20-11-2012 18:27:17
Iniciar servicio de windows jocey Varios 1 19-09-2008 21:29:13
Problema al iniciar servicio con windows. mcalmanovici Varios 2 27-06-2008 17:13:21
Detener\Iniciar proceso de windows jocey Varios 3 19-02-2008 02:41:26


La franja horaria es GMT +2. Ahora son las 17:23:12.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi