Author  

Language  

Operating Systems  

'Here is a class and module that enumerates the services
'on a Windows NT workstation, it gets each service and puts its info into a public collection
'which can be used anywhere in the program.

'Here is what goes in the class module clsService

Option Explicit
'Local Constants

Private Const SERVICE_STOPPED = &H1
Private Const SERVICE_START_PENDING = &H2
Private Const SERVICE_STOP_PENDING = &H3
Private Const SERVICE_RUNNING = &H4
Private Const SERVICE_CONTINUE_PENDING = &H5
Private Const SERVICE_PAUSE_PENDING = &H6
Private Const SERVICE_PAUSED = &H7
Private Const SERVICE_ACCEPT_STOP = &H1
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_SHUTDOWN = &H4

'Local Variables
Private mvarDisplayName As String 'local copy
Private mvarServiceName As String 'local copy
Private mvarServiceStatus As String 'local copy
Private mvarAcceptStop As Boolean 'local copy
Private mvarAcceptShutDown As Boolean 'local copy
Private mvarAcceptPause As Boolean 'local copy
Private mvarControlsAccepted As Long 'local copy
Private mvarCurrentStatus As Long 'local copy

'CurrentStatus,ControlsAccepted,DisplayName,and Service Name
'Are Input
'Everything else is Read Only
'You can check the boolean values to find the service properties

Public Property Let CurrentStatus(ByVal vData As Long)
    mvarCurrentStatus = vData
End Property

Public Property Get CurrentStatus() As Long
    CurrentStatus = mvarCurrentStatus
End Property

Public Property Let ControlsAccepted(ByVal vData As Long)
    mvarControlsAccepted = vData
End Property

Public Property Get ControlsAccepted() As Long
    ControlsAccepted = mvarControlsAccepted
End Property

Public Property Get Running() As Boolean
    If (mvarCurrentStatus And SERVICE_RUNNING) = SERVICE_RUNNING Then
        Running = True
    Else
        Running = False
    End If
End Property

Public Property Get StartPending() As Boolean
    If (mvarCurrentStatus And SERVICE_START_PENDING) = SERVICE_START_PENDING Then
        StartPending = True
    Else
        StartPending = False
    End If
End Property

Public Property Get ContinuePending() As Boolean
    If (mvarCurrentStatus And SERVICE_CONTINUE_PENDING) = SERVICE_CONTINUE_PENDING Then
        ContinuePending = True
    Else
        ContinuePending = False
    End If
End Property

Public Property Get Paused() As Boolean
    If (mvarCurrentStatus And SERVICE_PAUSED) = SERVICE_PAUSED Then
        Paused = True
    Else
        Paused = False
    End If
End Property

Public Property Get PausePausing() As Boolean
    If (mvarCurrentStatus And SERVICE_PAUSE_PENDING) = SERVICE_PAUSE_PENDING Then
        PausePausing = True
    Else
        PausePausing = False
    End If
End Property

Public Property Get Stopped() As Boolean
    If (mvarCurrentStatus And SERVICE_STOPPED) = SERVICE_STOPPED Then
        Stopped = True
    Else
        Stopped = False
    End If
End Property

Public Property Get StopPending() As Boolean
    If (mvarCurrentStatus And SERVICE_STOP_PENDING) = SERVICE_STOP_PENDING Then
        StopPending = True
    Else
        StopPending = False
    End If
End Property

Public Property Get AcceptPause() As Boolean
    If (mvarControlsAccepted And SERVICE_ACCEPT_PAUSE_CONTINUE) = SERVICE_ACCEPT_PAUSE_CONTINUE Then
        AcceptPause = True
    Else
        AcceptPause = False
    End If
End Property

Public Property Get AcceptShutDown() As Boolean
    If (mvarControlsAccepted And SERVICE_ACCEPT_SHUTDOWN) = SERVICE_ACCEPT_SHUTDOWN Then
        AcceptShutDown = True
    Else
        AcceptShutDown = False
    End If
End Property

Public Property Get AcceptStop() As Boolean
    If (mvarControlsAccepted And SERVICE_ACCEPT_STOP) = SERVICE_ACCEPT_STOP Then
        AcceptStop = True
    Else
        AcceptStop = False
    End If
End Property

Public Property Let ServiceName(ByVal vData As String)
    mvarServiceName = vData
End Property

Public Property Get ServiceName() As String
    ServiceName = mvarServiceName
End Property

Public Property Let DisplayName(ByVal vData As String)
    mvarDisplayName = vData
End Property

Public Property Get DisplayName() As String
    DisplayName = mvarDisplayName
End Property

'Here is what goes in the Module

Option Explicit

'Structures

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

Type ENUM_SERVICE_STATUS
    lpServiceName As Long
    lpDisplayName As Long
    ServiceStatus As SERVICE_STATUS
End Type

'Constants

Public Const SERVICES_ACTIVE_DATABASE = "ServicesActive"
Public Const ERROR_MORE_DATA = 234
Public Const SERVICE_ACTIVE = &H1
Public Const SERVICE_INACTIVE = &H2
Public Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Public Const SERVICE_WIN32_OWN_PROCESS As Long = &H10
Public Const SERVICE_WIN32_SHARE_PROCESS As Long = &H20
Public Const SERVICE_WIN32 As Long = SERVICE_WIN32_OWN_PROCESS _
+ SERVICE_WIN32_SHARE_PROCESS

'Error Constants
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_DATABASE_DOES_NOT_EXIST = 1065&
Public Const ERROR_INVALID_PARAMETER = 87

'Other
Public colServices As New Collection

'API declarations

Public Declare Function OpenSCManager Lib "advapi32.dll" _
Alias "OpenSCManagerA" _
(ByVal lpMachineName As String, ByVal lpDatabaseName As String, _
ByVal dwDesiredAccess As Long) As Long

Public 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

Public Declare Function CloseServiceHandle Lib "advapi32.dll" _
(ByVal hSCObject As Long) As Long

Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long

Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, ByVal lSize As Long)


Public Function TrimStr(strName As String) As String

    'Finds a null then trims the string
    Dim x As Integer
    x = InStr(strName, vbNullChar)
    If x > 0 Then TrimStr = Left$(strName, x - 1) Else TrimStr = strName

End Function

Function LPSTRtoSTRING(ByVal lngPointer As Long) As String

    Dim lngLength As Long

    'Get number of characters in string
    lngLength = lstrlenW(lngPointer) * 2
    'Initialize string so we have something to copy the string into
    LPSTRtoSTRING = String$(lngLength, 0)
    'Copy the string
    CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    'Convert to Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))

End Function

Public Sub GetServiceInfo(strHostName As String, lngServiceType As Long)

    Dim hSCM As Long
    Dim lpEnumServiceStatus() As ENUM_SERVICE_STATUS
    Dim lngServiceStatusInfoBuffer As Long
    Dim strServiceName As String
    Dim lngBytesNeeded As Long
    Dim lngServicesReturned As Long
    Dim hNextUnreadEntry As Long
    Dim lngStructsNeeded As Long
    Dim lngResult As Long
    Dim i As Long
    Dim uUser As ENUM_SERVICE_STATUS
    Dim Service As clsService

    'Check the conditions on the strHostname
    'Set to null or null terminated
    If strHostName = "" Then
        strHostName = vbNullString
    Else
        strHostName = strHostName & Chr(0)
    End If
    'Open connection to Service Control Manager.
    hSCM = OpenSCManager(strHostName, vbNullString, SC_MANAGER_ENUMERATE_SERVICE)
    'If an error results exit sub
    If hSCM = 0 Then
        MsgBox "OpenSCManager failed. LastDllError = " & CStr(Err.LastDllError)
        Exit Sub
    End If
    'Set the pointer to the first entry
    hNextUnreadEntry = 0
    'call the function with the buffer set to 0 this will generate a
    'ERROR_MORE_DATA return, but it also return the size of the buffer
    'we will need
    lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, lngServiceType, ByVal &H0, &H0, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
    'If an error other than ERROR_MORE_DATA exit sub
    If Not Err.LastDllError = ERROR_MORE_DATA Then
        MsgBox "LastDLLError = " & CStr(Err.LastDllError)
        Exit Sub
    End If
    'Calculate the number of structures needed.
    lngStructsNeeded = lngBytesNeeded / Len(lpEnumServiceStatus(0)) + 1
    'Redimension the array according to our calculation.
    ReDim lpEnumServiceStatus(lngStructsNeeded - 1)
    'Set buffer size in bytes.
    lngServiceStatusInfoBuffer = lngStructsNeeded * Len(lpEnumServiceStatus(0))
    'Set the pointer to the first entry
    hNextUnreadEntry = 0
    'Call the function
    lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, lngServiceType, lpEnumServiceStatus(0), lngServiceStatusInfoBuffer, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
    If lngResult = 0 Then
        MsgBox "EnumServicesStatus failed. LastDllError = " & CStr(Err.LastDllError)
        Exit Sub
    End If
    'Close our connection the Service Control Manager
    CloseServiceHandle (hSCM)
    'Get the info out of the buffer
    Set colServices = Nothing
    For i = 0 To lngServicesReturned - 1
        'Set a new temporary object based on the class
        Set Service = New clsService
        'Resolve the Service Names
        Service.ServiceName = LPSTRtoSTRING(lpEnumServiceStatus(i).lpServiceName)
        Service.DisplayName = LPSTRtoSTRING(lpEnumServiceStatus(i).lpDisplayName)
        'Resolve the Service Status info we want
        'Note the whole structure is returned I'm only pulling the info
        'I wanted feel free to add the rest
        Service.ControlsAccepted = lpEnumServiceStatus(i).ServiceStatus.dwControlsAccepted
        Service.CurrentStatus = lpEnumServiceStatus(i).ServiceStatus.dwCurrentState
        'Add this service to our collection
        colServices.Add Service, Service.DisplayName
        'Reset Service
        Set Service = Nothing
    Next

End Sub

Option Explicit

Private Sub Command1_Click()
    Dim x As clsService
    Dim strHostName as String
    'Usage

    'Call procedure, where strHostName is the name of the Machine, use "" for the
    'Local Machine
    strHostName=""
    GetServiceInfo strHostName, SERVICE_ACTIVE Or SERVICE_INACTIVE
    For Each x In colServices
        MsgBox x.ServiceName
    Next
End Sub