"Mads" <mads@iname.com> wrote in message news:btonlf$82r$1@sunsite.dk...
> "Mads" <mads@iname.com> wrote in message news:btonfa$bmq$1@sunsite.dk...
> > Hej
> >
> > Jeg har skrevet en NT service vha. NTsvc.ocx som køre som Local System
> > Account.
> >
> > Men hvorledes kan jeg via et andet VB program starte og stoppe servicen?
> > Jeg vil nemlig gerne lave en status monitor der kan styre servicen.
> >
> Glemte lige at skrive jeg bruger VB6
>
Fandt et eksempel på en webside, som jeg tilpassede lidt. Det ser ud til at
virke fint.
Koden er:
Option Explicit
Public Enum eServiceState
essStopService
essStartService
essPauseService
End Enum
Public Enum eServiceStatus
essServiceStatus_Unknown
essServiceStatus_Stopped
essServiceStatus_Stop_Pending
essServiceStatus_Running
essServiceStatus_Start_Pending
essServiceStatus_Paused
essServiceStatus_Pause_Pending
essServiceStatus_Continue_Pending
End Enum
Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal
hSCObject As Long) As Long
Private Declare Function ControlService Lib "advapi32.dll" (ByVal
lHwndService As Long, ByVal dwControl As Long, lpServiceStatus As
SERVICE_STATUS) 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 OpenService Lib "advapi32.dll" Alias "OpenServiceA"
(ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal
dwDesiredAccess As Long) As Long
Private Declare Function QueryServiceStatus Lib "advapi32.dll" (ByVal
lHwndService As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function StartService Lib "advapi32.dll" Alias
"StartServiceA" (ByVal lHwndService As Long, ByVal dwNumServiceArgs As Long,
ByVal lpServiceArgVectors As Long) As Long
Private Const SERVICES_ACTIVE_DATABASE = "ServicesActive"
Private Const SERVICE_CONTROL_STOP = &H1
Private Const SERVICE_CONTROL_PAUSE = &H2
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 STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SC_MANAGER_CONNECT = &H1
Private Const SC_MANAGER_CREATE_SERVICE = &H2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Private Const SC_MANAGER_LOCK = &H8
Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
Private Const SC_MANAGER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or
SC_MANAGER_CONNECT Or SC_MANAGER_CREATE_SERVICE Or
SC_MANAGER_ENUMERATE_SERVICE Or SC_MANAGER_LOCK Or
SC_MANAGER_QUERY_LOCK_STATUS Or SC_MANAGER_MODIFY_BOOT_CONFIG)
Private Const SERVICE_QUERY_CONFIG = &H1
Private Const SERVICE_CHANGE_CONFIG = &H2
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_PAUSE_CONTINUE = &H40
Private Const SERVICE_INTERROGATE = &H80
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or
SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG Or SERVICE_QUERY_STATUS Or
SERVICE_ENUMERATE_DEPENDENTS Or SERVICE_START Or SERVICE_STOP Or
SERVICE_PAUSE_CONTINUE Or SERVICE_INTERROGATE Or
SERVICE_USER_DEFINED_CONTROL)
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
Public Function ServiceStatus(sServiceName As String, Optional sComputerName
As String) As eServiceStatus
Dim tServiceStat As SERVICE_STATUS
Dim lHwndSManager As Long
Dim lHwndService As Long
Dim hServiceStatus As Long
'Check the input data
If InStr(1, sServiceName, " ") Then
Debug.Print "Service names cannot contain spaces. Use the 'Service
Name' of the service, not the 'Display Name'"
Exit Function
End If
ServiceStatus = essServiceStatus_Unknown
'Open the service manager
lHwndSManager = OpenSCManager(sComputerName, SERVICES_ACTIVE_DATABASE,
SC_MANAGER_ALL_ACCESS)
If lHwndSManager <> 0 Then
'Open the service
lHwndService = OpenService(lHwndSManager, sServiceName,
SERVICE_ALL_ACCESS)
If lHwndService <> 0 Then
'Query the service
hServiceStatus = QueryServiceStatus(lHwndService, tServiceStat)
If hServiceStatus <> 0 Then
Select Case tServiceStat.dwCurrentState
Case SERVICE_STOPPED
ServiceStatus = essServiceStatus_Stopped
Case SERVICE_START_PENDING
ServiceStatus = essServiceStatus_Start_Pending
Case SERVICE_STOP_PENDING
ServiceStatus = essServiceStatus_Stop_Pending
Case SERVICE_RUNNING
ServiceStatus = essServiceStatus_Running
Case SERVICE_CONTINUE_PENDING
ServiceStatus = essServiceStatus_Continue_Pending
Case SERVICE_PAUSE_PENDING
ServiceStatus = essServiceStatus_Pause_Pending
Case SERVICE_PAUSED
ServiceStatus = essServiceStatus_Paused
End Select
End If
'Close the service
CloseServiceHandle lHwndService
End If
'Close the service mananger
CloseServiceHandle lHwndSManager
End If
End Function
Public Function ServiceStateChange(sServiceName As String, eState As
eServiceState, Optional sComputerName As String) As Boolean
Dim tServiceStatus As SERVICE_STATUS
Dim lHwndSManager As Long
Dim lHwndService As Long
Dim lRes As Long
'Check the input data
If InStr(1, sServiceName, " ") Then
Debug.Print "Service names cannot contain spaces. Use the 'Service
Name' of the service, not the 'Display Name'"
ServiceStateChange = False
Exit Function
End If
'Open the service manager
lHwndSManager = OpenSCManager(sComputerName, SERVICES_ACTIVE_DATABASE,
SC_MANAGER_ALL_ACCESS)
If lHwndSManager <> 0 Then
'Open the service
lHwndService = OpenService(lHwndSManager, sServiceName,
SERVICE_ALL_ACCESS)
If lHwndService <> 0 Then
Select Case eState
Case essPauseService
'Pause the service
lRes = ControlService(lHwndService, SERVICE_CONTROL_PAUSE,
tServiceStatus)
Case essStartService
'Start the service
lRes = StartService(lHwndService, 0, 0)
Case essStopService
lRes = ControlService(lHwndService, SERVICE_CONTROL_STOP,
tServiceStatus)
Case Else
Debug.Print "Invalid Service State"
Debug.Assert False
End Select
If lRes Then
'Success
ServiceStateChange = True
Else
'Failed
ServiceStateChange = False
Debug.Print "Error in ServiceStateChange: " &
Err.LastDllError
Debug.Assert False
End If
CloseServiceHandle lHwndService
End If
CloseServiceHandle lHwndSManager
Else
Debug.Print "Failed to open service mananger!"
Debug.Assert False
ServiceStateChange = False
End If
End Function
Public Function isServicePending(myServiceStatus As eServiceStatus) As
Boolean
Select Case myServiceStatus
Case essServiceStatus_Continue_Pending, essServiceStatus_Pause_Pending,
_
essServiceStatus_Start_Pending, essServiceStatus_Stop_Pending, _
essServiceStatus_Unknown
isServicePending = True
Case essServiceStatus_Paused, essServiceStatus_Running,
essServiceStatus_Stopped
isServicePending = False
End Select
End Function
|