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
|