Zjištění stavu a konfigurace služby |
![]() |
Postup: Option Explicit Private Declare Function CloseServiceHandle Lib "advapi32.dll" _ (ByVal hSCObject As Long) As Long Private Declare Function QueryServiceStatus Lib "advapi32.dll" _ (ByVal hService As Long, _ lpServiceStatus As SERVICE_STATUS) 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 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 QueryServiceConfig Lib "advapi32.dll" _ Alias "QueryServiceConfigA" _ (ByVal hService As Long, _ lpServiceConfig As Byte, _ ByVal cbBufSize As Long, _ pcbBytesNeeded As Long) As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _ (hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) Private Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" _ (ByVal lpString1 As String, _ ByVal lpString2 As Long) As Long Private 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 Private Type QUERY_SERVICE_CONFIG dwServiceType As Long dwStartType As Long dwErrorControl As Long lpBinaryPathName As Long 'String lpLoadOrderGroup As Long ' String dwTagId As Long lpDependencies As Long 'String lpServiceStartName As Long 'String lpDisplayName As Long 'String End Type 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 Private Const SC_MANAGER_CONNECT = &H1 Private Const SERVICE_INTERROGATE = &H80 Private Const GENERIC_READ = &H80000000 Private Const ERROR_INSUFFICIENT_BUFFER = 122 Private Sub Command1_Click() Dim hSCM As Long Dim hSVC As Long Dim pSTATUS As SERVICE_STATUS Dim udtConfig As QUERY_SERVICE_CONFIG Dim lRet As Long Dim lBytesNeeded As Long Dim sTemp As String Dim pFileName As Long List1.Clear ' Otevření správce služeb hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT) If hSCM = 0 Then MsgBox "Chyba - " & Err.LastDllError End If ' Otevření specifické služby pro zjištění ukazatele hSVC = OpenService(hSCM, Trim(Text1.Text), GENERIC_READ) If hSVC = 0 Then MsgBox "Chyba - " & Err.LastDllError GoTo CloseHandles End If ' Vyplnění struktury o stavu služby lRet = QueryServiceStatus(hSVC, pSTATUS) If lRet = 0 Then MsgBox "Chyba - " & Err.LastDllError GoTo CloseHandles End If ' Oznámení aktuálního stavu Select Case pSTATUS.dwCurrentState Case SERVICE_STOPPED sTemp = "Služba je zastavena." Case SERVICE_START_PENDING sTemp = "Služba se nyní startuje." Case SERVICE_STOP_PENDING sTemp = "Služba je nyní ukončována." Case SERVICE_RUNNING sTemp = "Služba je spuštěna." Case SERVICE_CONTINUE_PENDING sTemp = "Služba přechází do normálního stavu." Case SERVICE_PAUSE_PENDING sTemp = "Služba přechází do pozastavení." Case SERVICE_PAUSED sTemp = "Služba je pozastavena." Case SERVICE_ACCEPT_STOP sTemp = "Služba je zastavena." Case SERVICE_ACCEPT_PAUSE_CONTINUE sTemp = "Služba je " Case SERVICE_ACCEPT_SHUTDOWN sTemp = "Služba je ukončována." End Select List1.AddItem "Stav služby : " & sTemp ReDim abConfig(0) As Byte lRet = QueryServiceConfig(hSVC, abConfig(0), 0&, lBytesNeeded) If lRet = 0 And Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then MsgBox "Chyba - " & Err.LastDllError End If ReDim abConfig(lBytesNeeded) As Byte lRet = QueryServiceConfig(hSVC, abConfig(0), lBytesNeeded, _ lBytesNeeded) If lRet = 0 Then MsgBox "Chyba - " & Err.LastDllError GoTo CloseHandles End If ' Vyplnění typu s konfigurací CopyMemory udtConfig, abConfig(0), Len(udtConfig) List1.AddItem "Typ služby: " & udtConfig.dwServiceType List1.AddItem "Typ spuštění služby: " & udtConfig.dwStartType List1.AddItem "Kontrola chyb službyl: " & udtConfig.dwErrorControl sTemp = Space(255) lRet = lstrcpy(sTemp, udtConfig.lpBinaryPathName) List1.AddItem "Binární cesta služby: " & sTemp lRet = lstrcpy(sTemp, udtConfig.lpDependencies) List1.AddItem "Závislosti: " & sTemp lRet = lstrcpy(sTemp, udtConfig.lpDisplayName) List1.AddItem "Zobrazovací jméno služby: " & sTemp lRet = lstrcpy(sTemp, udtConfig.lpLoadOrderGroup) List1.AddItem "Skupina služby: " & sTemp lRet = lstrcpy(sTemp, udtConfig.lpServiceStartName) List1.AddItem "Spouštěcí jméno služby: " & sTemp CloseHandles: ' Zavření ukazatele na službu CloseServiceHandle (hSVC) ' Zavření ukazatele na správce služeb CloseServiceHandle (hSCM) End Sub Spusťte projekt a do TextBoxu zapište název služby, například Eventlog. |
![]() |
Autor: The Bozena |