VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DMService"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long
Private Const SC_MANAGER_CONNECT = &H1
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Private Declare Function OpenService Lib "advapi32.dll" Alias "OpenServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal dwDesiredAccess As Long) As Long
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
Private Declare Function QueryServiceStatus Lib "advapi32.dll" (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Type SERVICE_STATUS
  dwServiceType As Long
  dwCurrentState As Long
  dwControlsAccepted As Long
  dwWin32ExitCode As Long
  dwServiceSpecificExitCode As Long
  dwCheckPoint As Long
  dwWaitHint As Long
End Type
Private Const SERVICE_RUNNING As Long = 4

Private Declare Function StartService Lib "advapi32.dll" Alias "StartServiceA" (ByVal hService As Long, ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long
Private Declare Function ControlService Lib "advapi32.dll" (ByVal hService As Long, ByVal dwControl As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Const SERVICE_CONTROL_STOP = &H1
Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As Long) As Long

Private mServer As String
Private mService As String

Public Sub Init(ServerName As String, ServiceName As String)
  mServer = ServerName
  mService = ServiceName
End Sub

Public Property Get ServerName() As String
  ServerName = mServer
End Property

Public Property Get ServiceName() As String
  ServiceName = mService
End Property

Public Function IsRunning() As Boolean
Dim hManager As Long
Dim hService As Long
Dim Status As SERVICE_STATUS
Dim res As Long
Dim NotOK As Boolean

  hManager = OpenSCManager(mServer, vbNullString, SC_MANAGER_CONNECT)
  If hManager <> 0 Then
    hService = OpenService(hManager, mService, SERVICE_QUERY_STATUS)
    If hService <> 0 Then
      res = QueryServiceStatus(hService, Status)
      If res <> 0 Then
        IsRunning = (Status.dwCurrentState = SERVICE_RUNNING)
      Else
        NotOK = True
      End If
      CloseServiceHandle hService
    Else
      NotOK = True
    End If
    CloseServiceHandle hManager
  Else
    NotOK = True
  End If
  
  If NotOK Then RaiseError
  
End Function

Public Sub ServiceStart()
Dim hManager As Long
Dim hService As Long
Dim res As Long
Dim NotOK As Boolean

  hManager = OpenSCManager(mServer, vbNullString, SC_MANAGER_CONNECT)
  If hManager <> 0 Then
    hService = OpenService(hManager, mService, SERVICE_START)
    If hService <> 0 Then
      res = StartService(hService, 0&, 0&)
      If res <> 0 Then
      Else
        NotOK = True
      End If
      CloseServiceHandle hService
    Else
      NotOK = True
    End If
    CloseServiceHandle hManager
  Else
    NotOK = True
  End If
  
  If NotOK Then RaiseError

End Sub

Public Sub ServiceStop()
Dim hManager As Long
Dim hService As Long
Dim Status As SERVICE_STATUS
Dim res As Long
Dim NotOK As Boolean

  hManager = OpenSCManager(mServer, vbNullString, SC_MANAGER_CONNECT)
  If hManager <> 0 Then
    hService = OpenService(hManager, mService, SERVICE_STOP)
    If hService <> 0 Then
      res = ControlService(hService, SERVICE_CONTROL_STOP, Status)
      If res <> 0 Then
      Else
        NotOK = True
      End If
      CloseServiceHandle hService
    Else
      NotOK = True
    End If
    CloseServiceHandle hManager
  Else
    NotOK = True
  End If
  
  If NotOK Then RaiseError

End Sub

Public Sub ServiceCommand(Command As Long)
Dim hManager As Long
Dim hService As Long
Dim Status As SERVICE_STATUS
Dim res As Long
Dim NotOK As Boolean

  hManager = OpenSCManager(mServer, vbNullString, SC_MANAGER_CONNECT)
  If hManager <> 0 Then
    hService = OpenService(hManager, mService, SERVICE_USER_DEFINED_CONTROL)
    If hService <> 0 Then
      res = ControlService(hService, Command, Status)
      If res <> 0 Then
      Else
        NotOK = True
      End If
      CloseServiceHandle hService
    Else
      NotOK = True
    End If
    CloseServiceHandle hManager
  Else
    NotOK = True
  End If
  
  If NotOK Then RaiseError

End Sub

Private Sub RaiseError()
  Err.Raise vbObjectError + 9999, App.EXEName, "Service API error"
End Sub
