' АПИ сервисов, коды ошибок
Private Const ERROR_MORE_DATA =  234  
Private Const ERROR_INVALID_PARAMETER =  87  
Private Const ERROR_INVALID_HANDLE =  6  
Private Const ERROR_ACCESS_DENIED =  5  
'Доступ к  control manager'у 
Private Const SC_MANAGER_CONNECT =  1  
Private Const SC_MANAGER_CREATE_SERVICE =  2  
Private Const SC_MANAGER_ENUMERATE_SERVICE =  4  
Private Const SC_MANAGER_LOCK =  8  
Private Const SC_MANAGER_QUERY_LOCK_STATUS =  16  
Private Const SC_MANAGER_MODIFY_BOOT_CONFIG =  32  
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 
Private Const SC_MANAGER_ALL_ACCESS = SC_MANAGER_CONNECT Or _ 
  SC_MANAGER_CREATE_SERVICE Or SC_MANAGER_ENUMERATE_SERVICE Or _ 
  SC_MANAGER_LOCK Or SC_MANAGER_QUERY_LOCK_STATUS Or _ 
  SC_MANAGER_MODIFY_BOOT_CONFIG Or STANDARD_RIGHTS_REQUIRED 
' доступ к сервису
Private Const SERVER_ACCESS_ENUMERATE = &H2 
Private Const SERVICE_QUERY_CONFIG = &H1 
Private Const SERVICE_CHANGE_CONFIG = &H2 
Private Const SERVICE_QUERY_STATUS = &H4 
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8 
Private Const SERVICE_START = &H10 
Private Const SERVICE_STOP = &H20 
Private Const SERVICE_PAUSE_CONTINUE = &H40 
Private Const SERVICE_INTERROGATE = &H80 
Private Const SERVICE_USER_DEFINED_CONTROL = &H100 
Private Const SERVICE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or _ 
  SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG Or _ 
  SERVICE_QUERY_STATUS Or SERVICE_ENUMERATE_DEPENDENTS Or _ 
  SERVICE_START Or SERVICE_STOP Or SERVICE_PAUSE_CONTINUE Or _ 
  SERVICE_INTERROGATE Or SERVICE_USER_DEFINED_CONTROL 
Public Enum SERVICE_STATE 
  SERVICE_UNKNOWN =  0  ' not a real status code 
  SERVICE_STOPPED = &H1 
  SERVICE_START_PENDING = &H2 
  SERVICE_STOP_PENDING = &H3 
  SERVICE_RUNNING = &H4 
  SERVICE_CONTINUE_PENDING = &H5 
  SERVICE_PAUSE_PENDING = &H6 
  SERVICE_PAUSED = &H7 
End Enum 
Private Enum SERVICE_CONTROL 
  SERVICE_CONTROL_STOP = &H1 
  SERVICE_CONTROL_PAUSE = &H2 
  SERVICE_CONTROL_CONTINUE = &H3 
  SERVICE_CONTROL_INTERROGATE = &H4 
  SERVICE_CONTROL_SHUTDOWN = &H5 
End Enum 
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 Type ENUM_SERVICE_STATUS 
  lpServiceName As String 
  lpDisplayName As String 
  ServiceStatus As SERVICE_STATUS 
End Type 
' типы сервисов 
Public Enum SERVICE_TYPE_FLAGS 
  SERVICE_WIN32_OWN_PROCESS =  16  'Флаг типа сервиса указывающий на сервис запущенный в собственном процессе
  SERVICE_WIN32_SHARE_PROCESS =  32  
  SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS Or SERVICE_WIN32_SHARE_PROCESS 
  SERVICE_KERNEL_DRIVER =  1  'Флаг драйвера устройства. 
  SERVICE_FILE_SYSTEM_DRIVER =  2  ' Драйвер системы.
  SERVICE_ADAPTER =  4  
  SERVICE_INTERACTIVE_PROCESS =  256   
  SERVICE_DRIVER = SERVICE_KERNEL_DRIVER Or SERVICE_FILE_SYSTEM_DRIVER Or 
SERVICE_ADAPTER Or SERVICE_INTERACTIVE_PROCESS 
  SERVICE_ALL = SERVICE_WIN32 Or SERVICE_DRIVER 
End Enum 
' Состояние сервиса, для опроса.
Private Const SERVICE_INACTIVE = &H2 
Private Const SERVICE_ACTIVE = &H1 
Private Const SERVICE_STATE_ALL = (SERVICE_ACTIVE Or SERVICE_INACTIVE) 
Private Declare Function EnumServicesStatus Lib "advapi32.dll" _ 
  Alias "EnumServicesStatusA" (ByVal hSCManager As Long, ByVal dwServiceType 
As Long, _ 
  ByVal dwServiceState As Long, lpServices As Byte, _ 
  ByVal cbBufSize As Long, pcbBytesNeeded As Long, lpServicesReturned As 
Long, _ 
  lpResumeHandle As Long) As Long 
Private Declare Function OpenSCManager _ 
   Lib "advapi32.dll" Alias "OpenSCManagerA" _ 
   (ByVal lpMachineName As String, ByVal lpDatabaseName As String, _ 
   ByVal dwDesiredAccess As Long) As Long 
Private Declare Function CloseServiceHandle _ 
   Lib "advapi32.dll" (ByVal hSCObject As Long) As Long 
Private Declare Function SetServiceStatus _ 
   Lib "advapi32.dll" (ByVal ServiceStatus As Long, _ 
   lpServiceStatus As SERVICE_STATUS) As Long 
Private Declare Function QueryServiceStatus _ 
   Lib "advapi32.dll" (ByVal hService As Long, _ 
   lpServiceStatus As SERVICE_STATUS) As Long 
Private Declare Function OpenService _ 
   Lib "advapi32.dll" Alias "OpenServiceA" _ 
   (ByVal hSCManager As Long, ByVal lpServiceName As String, _ 
   ByVal dwDesiredAccess As Long) As Long 
Private Declare Function ControlService Lib "advapi32.dll" _ 
  (ByVal hService As Long, ByVal controlcommand As Long, _ 
  lpServiceStatus As SERVICE_STATUS) As Long 
Private Declare Function StartService Lib "advapi32.dll" _ 
  Alias "StartServiceA" (ByVal hService As Long, _ 
  ByVal ArgCount As Long, ByVal lpArgVectors As Long) As Long 
Private Declare Function GetServiceKeyName Lib "advapi32.dll" _ 
  Alias "GetServiceKeyNameA" (ByVal hSCManager As Long, _ 
  ByVal DisplayName As String, ByVal ServiceName As String, _ 
  BuffSize As Long) As Long 
Private Declare Function GetServiceDisplayName Lib "advapi32.dll" _ 
  Alias "GetServiceDisplayNameA" (ByVal hSCManager As Long, _ 
  ByVal ServiceName As String, ByVal DisplayName As String, _ 
  BuffSize As Long) As Long 
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" _ 
  (xdest As Any, xsource As Any, ByVal xsize As Long) 


Event ServiceEntry(ByVal ServiceName As String, _ 
  ByVal DisplayName As String, ByVal CurrentState As SERVICE_STATE) 


Public Function GetServiceState(ByVal ServiceName As String) As 
SERVICE_STATE 
Dim x As Long 
Dim hSCManager As Long 
Dim hService As Long 
Dim udtStatus As SERVICE_STATUS 
GetServiceState = SERVICE_UNKNOWN 
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  hService = OpenService(hSCManager, ServiceName, SERVICE_QUERY_STATUS) 
  If hService <>  0  Then 
    If QueryServiceStatus(hService, udtStatus) =  1  Then 
      GetServiceState = udtStatus.dwCurrentState 
    End If 
    Call CloseServiceHandle(hService) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function SetServicePaused(ByVal ServiceName As String) As 
SERVICE_STATE 
Dim udtStatus As SERVICE_STATUS 
Dim hSCManager As Long 
Dim hService As Long 
SetServicePaused = SERVICE_UNKNOWN 
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  hService = OpenService(hSCManager, ServiceName, SERVICE_PAUSE_CONTINUE) 
  If hService <>  0  Then 
    If ControlService(hService, SERVICE_CONTROL_PAUSE, udtStatus) =  1  Then 
      SetServicePaused = udtStatus.dwCurrentState 
    End If 
    Call CloseServiceHandle(hService) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function SetServiceContinued(ByVal ServiceName As String) As 
SERVICE_STATE 
Dim udtStatus As SERVICE_STATUS 
Dim hSCManager As Long 
Dim hService As Long 
SetServiceContinued = SERVICE_UNKNOWN 
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  hService = OpenService(hSCManager, ServiceName, SERVICE_PAUSE_CONTINUE) 
  If hService <>  0  Then 
    If ControlService(hService, SERVICE_CONTROL_CONTINUE, udtStatus) =  1  
Then 
      SetServiceContinued = udtStatus.dwCurrentState 
    End If 
    Call CloseServiceHandle(hService) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function SetServiceStarted(ByVal ServiceName As String) As 
SERVICE_STATE 
Dim hSCManager As Long 
Dim hService As Long 
SetServiceStarted = SERVICE_UNKNOWN 
hSCManager = OpenSCManager(vbNullString, vbNullString, 
SC_MANAGER_ALL_ACCESS) 
If hSCManager <>  0  Then 
  hService = OpenService(hSCManager, ServiceName, SERVICE_ALL_ACCESS) 
  If hService <>  0  Then 
    Err.Clear 
    If StartService(hService,  0 ,  0 ) =  1  Then 
      SetServiceStarted = SERVICE_RUNNING 
    End If 
    Call CloseServiceHandle(hService) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function SetServiceStopped(ByVal ServiceName As String) As 
SERVICE_STATE 
Dim udtStatus As SERVICE_STATUS 
Dim hSCManager As Long 
Dim hService As Long 
SetServiceStopped = SERVICE_UNKNOWN 
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  hService = OpenService(hSCManager, ServiceName, SERVICE_STOP) 
  If hService <>  0  Then 
    If ControlService(hService, SERVICE_CONTROL_STOP, udtStatus) =  1  Then 
      SetServiceStopped = udtStatus.dwCurrentState 
    End If 
    Call CloseServiceHandle(hService) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function GetServiceName(ByVal DisplayName As String) As String 
Dim sOut As String 
Dim hSCManager As Long 
Dim x As Long 
GetServiceName = DisplayName ' default 
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  sOut = Space$( 256 ) 
  x = Len(sOut) 
  If GetServiceKeyName(hSCManager, DisplayName, sOut, x) =  1  Then 
    x = InStr(sOut, vbNullChar) 
    If x >  0  Then GetServiceName = Left$(sOut, x -  1 ) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function GetDisplayName(ByVal ServiceName As String) As String 
Dim sOut As String 
Dim hSCManager As Long 
Dim x As Long 
GetDisplayName = ServiceName ' default 
hSCManager = OpenSCManager(vbNullString, vbNullString, _ 
  SC_MANAGER_CONNECT) 
If hSCManager <>  0  Then 
  sOut = Space$( 256 ) 
  x = Len(sOut) 
  If GetServiceDisplayName(hSCManager, ServiceName, sOut, x) =  1  Then 
    x = InStr(sOut, vbNullChar) 
    If x >  0  Then GetDisplayName = Left$(sOut, x -  1 ) 
  End If 
  Call CloseServiceHandle(hSCManager) 
End If 
End Function 


Public Function EnumerateServices() As Variant 
Dim hSCManager As Long 
Dim udtStatus As SERVICE_STATUS 
Dim sName As String 
Dim sDisplay As String 
Dim lSize As Long 
Dim lCount As Long 
Dim lRestart As Long 
Dim lError As Long 
Dim x As Long 
Dim bytServices() As Byte 
Dim lStart As Long 
Dim lString As Long
Dim lStatus As Long 
Dim sNames() As String
 
ReDim sNames( 0  To  0 ) ' проблема или нет сервисов
hSCManager = OpenSCManager(vbNullString, vbNullString, _ 
  SC_MANAGER_ENUMERATE_SERVICE) 
ReDim bytServices( 1  To  5000 ) As Byte ' примерный рамер
If hSCManager <>  0  Then 
  Do 
    lRestart =  0  
    x = EnumServicesStatus(hSCManager, SERVICE_WIN32, _ 
      SERVICE_STATE_ALL, bytServices( 1 ), UBound(bytServices), _ 
      lSize, lCount, lRestart) 
    lError = Err.LastDllError 
    If lError = ERROR_MORE_DATA Then 
      ReDim bytServices( 1  To lSize + UBound(bytServices)) ' увеличим буффер
    ElseIf x =  0  Or lCount <  1  Then 
      Exit Do ' проблема
    Else 
      lStart = VarPtr(bytServices( 1 )) 
      lStatus =  1  
      ReDim sNames( 1  To lCount) 
      For x =  1  To lCount 
        Call CopyMemory(lString, bytServices(lStatus),  4 ) 
        sName = GetString(bytServices, lString - lStart +  1 ) 
        sNames(x) = sName 
        Call CopyMemory(lString, bytServices(lStatus +  4 ),  4 )  
        sDisplay = GetString(bytServices, lString - lStart +  1 ) 
        Call CopyMemory(udtStatus, bytServices(lStatus +  8 ), 
LenB(udtStatus)) 
        lStatus = lStatus + LenB(udtStatus) +  8  
        RaiseEvent ServiceEntry(sName, sDisplay, udtStatus.dwCurrentState) 
      Next x 
    End If 
  Loop While lError = ERROR_MORE_DATA 
  Call CloseServiceHandle(hSCManager) 
End If 
EnumerateServices = sNames
End Function 


Private Function GetString(ByRef bdata() As Byte, ByRef offset As Long) As 
String 
Dim sOut As String 
Dim x As Long 
Do While bdata(offset) >  0  
  sOut = sOut & Chr$(bdata(offset)) 
  offset = offset +  1  
Loop 
GetString = sOut 
End Function 


Private Function GetServiceStateName(ByVal ServiceName As String) As String 
Select Case GetServiceState(ServiceName) 
  Case SERVICE_STOPPED: GetServiceStateName = "Stopped" 
  Case SERVICE_START_PENDING: GetServiceStateName = "Starting" 
  Case SERVICE_STOP_PENDING: GetServiceStateName = "Stopping" 
  Case SERVICE_RUNNING: GetServiceStateName = "Running" 
  Case SERVICE_CONTINUE_PENDING: GetServiceStateName = "Continuing" 
  Case SERVICE_PAUSE_PENDING: GetServiceStateName = "Pausing" 
  Case SERVICE_PAUSED: GetServiceStateName = "Paused" 
  Case Else: GetServiceStateName = "Unknown" 
End Select 
End Function