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