Zjištění stavu a konfigurace služby

Postup:
Založte nový projekt a na formulář přidejte tlačítko, TextBox a ListBox. Nastavte vlastnost TextBox1.Text="". Pak zapište následující kód:

   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.

Zpět