Informace o službě

Postup:
Private Type SERVICE_STATUS   ' 28 bytů
    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 bytů
    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

' hodnoty pro aktuální stav služby
Const SERVICE_STOPPED = 1           
Const SERVICE_START_PENDING = 2     
Const SERVICE_STOP_PENDING = 3      
Const SERVICE_RUNNING = 4           
Const SERVICE_CONTINUE_PENDING = 5  
Const SERVICE_PAUSE_PENDING = 6     
Const SERVICE_PAUSED = 7            

' hodnoty pro akceptovatelné příkazy služby
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


' Vrací pole proměnných, kde
'   arrInfo(n, 0) - interní jméno služby (string)
'   arrInfo(n, 1) - zobrazované jméno služby (string)
'   arrInfo(n, 2) - aktivační stav služby (enumerated)
'   arrInfo(n, 3) - sada příkazů, akceptovatelných službou (enumerated)

' Vrací True při úspěšném provedení, jinak False
' v případě chyby volejte Err.LastDLLError pro více informací


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
    
    hSCM = OpenSCManager(vbNullString, vbNullString, _
        SC_MANAGER_ENUMERATE_SERVICE)
    If hSCM = 0 Then Exit Function
    
    handleNext = 0
    EnumServicesStatus hSCM, SERVICE_WIN32, SERVICE_ALL, ByVal 0&, 0, _
        bytesNeeded, 0, handleNext
    If Err.LastDllError <> ERROR_MORE_DATA Then GoTo CleanUp
    
    numberOfServices = bytesNeeded / 36
    ReDim ServicesInfo(1 To numberOfServices) As ENUM_SERVICE_STATUS
    
    handleNext = 0
    res = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ALL, ServicesInfo(1), _
        Len(ServicesInfo(1)) * numberOfServices, bytesNeeded, numberOfServices, _
        handleNext)
    If res = 0 Then GoTo CleanUp
    
    ReDim arrInfo(1 To numberOfServices, 0 To 3)
    For ndx = 1 To numberOfServices
        lstrcpy ByVal buffer, ByVal ServicesInfo(ndx).lpServiceName
        arrInfo(ndx, 0) = Left$(buffer, InStr(buffer, vbNullChar) - 1)
        lstrcpy ByVal buffer, ByVal ServicesInfo(ndx).lpDisplayName
        arrInfo(ndx, 1) = Left$(buffer, InStr(buffer, vbNullChar) - 1)
        arrInfo(ndx, 2) = ServicesInfo(ndx).ServiceStatus.dwCurrentState
        arrInfo(ndx, 3) = ServicesInfo(ndx).ServiceStatus.dwControlsAccepted
    Next
    
    GetServicesInfo = True

CleanUp:
    CloseServiceHandle hSCM

End Function

Zpět

Autor: The Bozena