VB 在NT系统中安装服务
mServicesControl.bas
_
Alias "StartServiceCtrlDispatcherA" (lpServiceStartTable As SERVICE_TABLE_ENTRY) As Long
Private Declare Function RegisterServiceCtrlHandler _
Lib "advapi32.dll" _
Alias "RegisterServiceCtrlHandlerA" (ByVal lpServiceName As String, _
ByVal lpHandlerProc As Long) As Long
Private Declare Function SetServiceStatus _
Lib "advapi32.dll" (ByVal hServiceStatus 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 CreateService _
Lib "advapi32.dll" _
Alias "CreateServiceA" (ByVal hSCManager As Long, _
ByVal lpServiceName As String, _
ByVal lpDisplayName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwServiceType As Long, _
ByVal dwStartType As Long, _
ByVal dwErrorControl As Long, _
ByVal lpBinaryPathName As String, _
ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, ByVal lpDependencies As String, ByVal lp As String, ByVal lpPassword As String) As Long
Private Declare Function DeleteService _
Lib "advapi32.dll" (ByVal hService As Long) As Long
Declare Function CloseServiceHandle _
Lib "advapi32.dll" (ByVal hSCObject As Long) As Long
Declare Function OpenService _
Lib "advapi32.dll" _
Alias "OpenServiceA" (ByVal hSCManager As Long, _
ByVal lpServiceName As String, _
ByVal dwDesiredAccess As Long) As Long
Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUS
Dim SERVICE_NAME As String
Public Sub InstallService(ServiceName As String, _
ServiceFilePath, _
serviceType As e_ServiceType)
Dim hSCManager As Long
Dim hService As Long
Dim cmd As String
Dim lServiceType As Long
Dim iph As Long
Select Case serviceType
Case e_ServiceType_Automatic
lServiceType = SERVICE_AUTO_START
Case e_ServiceType_BootTime
lServiceType = SERVICE_BOOT_START
Case e_ServiceType_Disabled
lServiceType = SERVICE_DISABLED
Case e_ServiceType_Manual
lServiceType = SERVICE_DEMAND_START
Case e_ServiceType_SystemStart
lServiceType = SERVICE_SYSTEM_START
End Select
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_Create_SERVICE)
' CreateService (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal lpDisplayName As String, ByVal dwDesiredAccess As Long, ByVal dwServiceType As Long, ByVal dwStartType As Long, ByVal dwErrorControl As Long, ByVal lpBinaryPathName As String, ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, ByVal lpDependencies As String, ByVal lp As String, ByVal lpPassword As String) As Long
hService = CreateService(hSCManager, ServiceName, ServiceName, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, lServiceType, SERVICE_ERROR_NORMAL, ServiceFilePath, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString)
'iph = RegisterServiceCtrlHandler(serviceName, hService)
CloseServiceHandle hService
CloseServiceHandle hSCManager
End Sub
Public Sub RemoveService(ServiceName As String)
Dim hSCManager As Long
Dim hService As Long
Dim cmd As String
hSCManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_Create_SERVICE)
hService = OpenService(hSCManager, ServiceName, SERVICE_ALL_ACCESS)
DeleteService hService
CloseServiceHandle hService
CloseServiceHandle hSCManager
End Sub
Public Function RunService(ServiceName As String) As Boolean
Dim ServiceTableEntry As SERVICE_TABLE_ENTRY
Dim b As Boolean
ServiceTableEntry.lpServiceName = ServiceName
SERVICE_NAME = ServiceName
ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
b = StartServiceCtrlDispatcher(ServiceTableEntry)
RunService = b
Debug.Print b
End Function
Private Sub Handler(ByVal fdwControl As Long)
Dim b As Boolean
Select Case fdwControl
Case SERVICE_CONTROL_PAUSE
ServiceStatus.dwCurrentState = SERVICE_PAUSED
Case SERVICE_CONTROL_CONTINUE
ServiceStatus.dwCurrentState = SERVICE_RUNNING
Case SERVICE_CONTROL_STOP
ServiceStatus.dwWin32ExitCode = 0
ServiceStatus.dwCurrentState = SERVICE_STOP_PENDING
ServiceStatus.dwCheckPoint = 0
ServiceStatus.dwWaitHint = 0
b = SetServiceStatus(hServiceStatus, ServiceStatus)
ServiceStatus.dwCurrentState = SERVICE_STOPPED
Case SERVICE_CONTROL_INTERROGATE
Case Else
End Select
b = SetServiceStatus(hServiceStatus, ServiceStatus)
End Sub
Private Function FncPtr(ByVal fnp As Long) As Long
FncPtr = fnp
End Function
Private Sub ServiceMain(ByVal dwArgc As Long, _
ByVal lpszArgv As Long)
Dim b As Boolean
'Set initial state
ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
ServiceStatus.dwCurrentState = SERVICE_START_PENDING
ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_PAUSE_CONTINUE Or SERVICE_ACCEPT_SHUTDOWN
ServiceStatus.dwWin32ExitCode = 0
ServiceStatus.dwServiceSpecificExitCode = 0
ServiceStatus.dwCheckPoint = 0
ServiceStatus.dwWaitHint = 0
hServiceStatus = RegisterServiceCtrlHandler(SERVICE_NAME, AddressOf Handler)
ServiceStatus.dwCurrentState = SERVICE_START_PENDING
b = SetServiceStatus(hServiceStatus, ServiceStatus)
ServiceStatus.dwCurrentState = SERVICE_RUNNING
b = SetServiceStatus(hServiceStatus, ServiceStatus)
End Sub
?
