Option Explicit

Private Type SERVICE_STATUS   ' 28 bytes
    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    ' 36 bytes
    lpServiceName As Long
    lpDisplayName As Long
    ServiceStatus As SERVICE_STATUS
End Type

Const SERVICE_ACTIVE = &H1&
Const SERVICE_INACTIVE = &H2&
Const SERVICE_ALL = SERVICE_ACTIVE + SERVICE_INACTIVE
Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Const ERROR_MORE_DATA = 234

Const SERVICE_WIN32_OWN_PROCESS = &H10&
Const SERVICE_WIN32_SHARE_PROCESS = &H20&
Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + SERVICE_WIN32_SHARE_PROCESS

' values for a service's current state
Const SERVICE_STOPPED = 1           ' stopped
Const SERVICE_START_PENDING = 2     ' starting
Const SERVICE_STOP_PENDING = 3      ' stopping
Const SERVICE_RUNNING = 4           ' running
Const SERVICE_CONTINUE_PENDING = 5  ' continuing
Const SERVICE_PAUSE_PENDING = 6     ' pausing
Const SERVICE_PAUSED = 7            ' paused

' values for commands accepted by a service (biut-fielded)
Const SERVICE_ACCEPT_STOP = 1
Const SERVICE_ACCEPT_PAUSE_CONTINUE = 2
Const SERVICE_ACCEPT_SHUTDOWN = 4
Const SERVICE_ACCEPT_PARAMCHANGE = 8
Const SERVICE_ACCEPT_NETBINDCHANGE = &H10

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 EnumServicesStatus Lib "advapi32.dll" Alias _
    "EnumServicesStatusA" (ByVal hSCManager As Long, _
    ByVal dwServiceType As Long, ByVal dwServiceState As Long, _
    lpServices As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long, _
    lpServicesReturned As Long, lpResumeHandle As Long) As Long
Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject _
    As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (szDest As _
    String, szcSource As Long) 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


' Return information on Windows NT services
' it returns an array of Variants, where
'   arrInfo(n, 0) is the service name (string)
'   arrInfo(n, 1) is the service display name (string)
'   arrInfo(n, 2) is the activation state of the service (enumerated)
'   arrInfo(n, 3) is the set of commands accepted by the service (enumerated)

' returns True if successful, False otherwise
' if any error, call Err.LastDLLError for more information

Function GetServicesInfo(arrInfo() As Variant) As Boolean
    Dim hSCM As Long
    Dim buffer As String * 256
    Dim bytesNeeded As Long
    Dim numberOfServices As Long
    Dim handleNext As Long
    Dim res As Long
    Dim ndx As Long, i As Long
    
    ' open the connection to Service Control Manager, exit if error
    hSCM = OpenSCManager(vbNullString, vbNullString, _
        SC_MANAGER_ENUMERATE_SERVICE)
    If hSCM = 0 Then Exit Function
    
    ' get buffer size in bytes, but without passing a buffer
    handleNext = 0
    EnumServicesStatus hSCM, SERVICE_WIN32, SERVICE_ALL, ByVal 0&, 0, _
        bytesNeeded, 0, handleNext
    ' we expect a MORE_DATA error
    If Err.LastDllError <> ERROR_MORE_DATA Then GoTo CleanUp
    
    ' evaluate the number of services
    '###########################################################
    ' original line: numberOfServices = bytesNeeded / 36
    ' patch proposed by Klaus Pater to make this routine compatible with
    ' WinNT/2000 workstation
    numberOfServices = bytesNeeded / 36 + 1
    
    ' Redimension the array to receive info on the services
    ReDim ServicesInfo(1 To numberOfServices) As ENUM_SERVICE_STATUS
    
    ' do the call again, this time passing the actual buffer
    handleNext = 0
    res = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ALL, ServicesInfo(1), _
        Len(ServicesInfo(1)) * numberOfServices, bytesNeeded, numberOfServices, _
        handleNext)
    ' error if previous function returns zero
    If res = 0 Then GoTo CleanUp
    
    ' fill the result array
    ReDim arrInfo(1 To numberOfServices, 0 To 3)
    For ndx = 1 To numberOfServices
        ' move service name into buffer and then to the array
        lstrcpy ByVal buffer, ByVal ServicesInfo(ndx).lpServiceName
        arrInfo(ndx, 0) = Left$(buffer, InStr(buffer, vbNullChar) - 1)
        ' move service display name into buffer and then to the array
        lstrcpy ByVal buffer, ByVal ServicesInfo(ndx).lpDisplayName
        arrInfo(ndx, 1) = Left$(buffer, InStr(buffer, vbNullChar) - 1)
        ' move activation state and accepted commands into result array
        arrInfo(ndx, 2) = ServicesInfo(ndx).ServiceStatus.dwCurrentState
        arrInfo(ndx, 3) = ServicesInfo(ndx).ServiceStatus.dwControlsAccepted
    Next
    
    ' return success
    GetServicesInfo = True

CleanUp:
    ' close the SCM
    CloseServiceHandle hSCM

End Function