Binaryworld - GetServicesInfo - Enumerate Windows NT services ... [ VB -> Windows ]

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