注意：是类模块，不是模块。别搞错了。
用法：
Private Sub Command1_Click()
Dim NTSrv As New SetSvc
With NTSrv
.Name = "nvsvc" '服务名称
.DisplayName = "NVIDIA Display Driver Service" '显示名称
.Description = "Provides system and desktop level support to the NVIDIA display driver." '描述
.Command = "C:\Program Files\NVIDIA\xoxx.exe" '执行文件
.Account = "LocalSystem" '启动用户
.Interact = SERVICE_INTERACT_WITH_DESKTOP '与桌面交互
.StartType = SERVICE_AUTO_START '启动方式 SERVICE_AUTO_START=自动,SERVICE_DEMAND_START=手动
.DeleteNTService '先删掉存在的
.SetNTService '设置新服务(如果是自动,则直接运行)
End With
End Sub
类模块代码：
Option Explicit
'系统服务操作类模块
'函数示例:
'SetNTService() '安装服务
'StartNTService() '开始服务
'StopNTService() '停止服务
'DeleteNTService() '卸载服务
'GetServiceConfig() '检测服务是否安装:返回0则安装
'GetServiceStatus '当前服务状态:4运行，1停止
'
'应用实例:
'Dim NTSrv As New SetSvc
'With NTSrv
' .Name = "This is test Server" '服务名称
' .DisplayName = "It's Test" '显示名称
' .Description = "This is test Server!" '描述
' .Command = "c:\cmd.exe" '执行文件
' .Account = "LocalSystem" '启动用户
' .Interact = SERVICE_INTERACT_WITH_DESKTOP '与桌面交互
' .StartType = SERVICE_AUTO_START '启动方式 SERVICE_AUTO_START=自动,SERVICE_DEMAND_START=手动
' .DeleteNTService '先删掉存在的
' .SetNTService '设置新服务(如果是自动,则直接运行)
'End With
Private Const ERROR_SERVICE_DOES_NOT_EXIST = 1060&
Private Const SC_MANAGER_CREATE_SERVICE = &H2&
Private Const SC_MANAGER_CONNECT = &H1&
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_CONFIG_DESCRIPTION = 1&
Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
Private Const SERVICE_INTERACTIVE_PROCESS = &H100&
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)
Public Enum SERVICE_START_TYPE
SERVICE_AUTO_START = 2&
SERVICE_DEMAND_START = 3&
SERVICE_DISABLED = &H4
End Enum
Public Enum SERVICE_INTERACT_TYPE
SERVICE_INTERACT_WITHNOT_DESKTOP = &H10&
SERVICE_INTERACT_WITH_DESKTOP = &H10& Or &H100&
End Enum
Private Const SERVICE_ERROR_NORMAL As Long = 1
Private Const ERROR_INSUFFICIENT_BUFFER = 122&
Private Enum SERVICE_CONTROL
SERVICE_CONTROL_STOP = 1&
SERVICE_CONTROL_PAUSE = 2&
SERVICE_CONTROL_CONTINUE = 3&
SERVICE_CONTROL_INTERROGATE = 4&
SERVICE_CONTROL_SHUTDOWN = 5&
End Enum
Public Enum SERVICE_STATE
SERVICE_STOPPED = &H1
SERVICE_START_PENDING = &H2
SERVICE_STOP_PENDING = &H3
SERVICE_RUNNING = &H4
SERVICE_CONTINUE_PENDING = &H5
SERVICE_PAUSE_PENDING = &H6
SERVICE_PAUSED = &H7
End Enum
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
lpLoadOrderGroup As Long
dwTagId As Long
lpDependencies As Long
lpServiceStartName As Long
lpDisplayName As Long
End Type
Private Declare Function QueryServiceConfig Lib "advapi32" Alias "QueryServiceConfigW" (ByVal hService As Long, lpServiceConfig As QUERY_SERVICE_CONFIG, ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long
Private Declare Function QueryServiceStatus Lib "advapi32" (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function OpenSCManager Lib "advapi32" Alias "OpenSCManagerW" (ByVal lpMachineName As Long, ByVal lpDatabaseName As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function OpenService Lib "advapi32" Alias "OpenServiceW" (ByVal hSCManager As Long, ByVal lpServiceName As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function ControlService Lib "advapi32" (ByVal hService As Long, ByVal dwControl As SERVICE_CONTROL, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function DeleteService Lib "advapi32" (ByVal hService As Long) As Long
Private Declare Function CloseServiceHandle Lib "advapi32" (ByVal hSCObject As Long) As Long
Private Declare Function CreateService Lib "advapi32" Alias "CreateServiceW" (ByVal hSCManager As Long, ByVal lpServiceName As Long, ByVal lpDisplayName As Long, ByVal dwDesiredAccess As Long, ByVal dwServiceType As Long, ByVal dwStartType As Long, ByVal dwErrorControl As Long, ByVal lpBinaryPathName As Long, ByVal lpLoadOrderGroup As Long, ByVal lpdwTagId As Long, ByVal lpDependencies As Long, ByVal lpServiceStartName As Long, ByVal lpPassword As Long) As Long
Private Declare Function ChangeServiceConfig2 Lib "advapi32" Alias "ChangeServiceConfig2W" (ByVal hService As Long, ByVal dwInfoLevel As Long, lpInfo As Any) As Long
Private Declare Function StartService Lib "advapi32" Alias "StartServiceW" (ByVal hService As Long, ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long
Private Declare Function NetWkstaUserGetInfo Lib "Netapi32" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32" (ByVal lpBuffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Service_Name As String
Private Service_Display_Name As String
Private Service_File_Path As String
Private Service_Description As String
Private Service_Account As String
Private Service_Password As String
Private Service_Type As Long
Private Service_Interact As Long
Public Function GetServiceStatus() As SERVICE_STATE '查询服务运行状态,4运行，1停止
Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_QUERY_STATUS)
If hService Then
If QueryServiceStatus(hService, Status) Then
GetServiceStatus = Status.dwCurrentState
End If
CloseServiceHandle hService
End If
CloseServiceHandle hSCManager
End If
End Function
Public Function GetServiceConfig() As Long '检测服务是否安装,返回0则安装
Dim hSCManager As Long, hService As Long
Dim r As Long, SCfg() As QUERY_SERVICE_CONFIG, r1 As Long, s As String
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_QUERY_CONFIG)
If hService Then
ReDim SCfg(1 To 1)
If QueryServiceConfig(hService, SCfg(1), 36, r) = 0 Then
If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
r1 = r \ 36 + 1
ReDim SCfg(1 To r1)
If QueryServiceConfig(hService, SCfg(1), r1 * 36, r) Then
s = Space$(lstrlenW(SCfg(1).lpServiceStartName))
lstrcpyW StrPtr(s), SCfg(1).lpServiceStartName
Service_Account = s
Else
GetServiceConfig = Err.LastDllError
End If
Else
GetServiceConfig = Err.LastDllError
End If
End If
CloseServiceHandle hService
Else
GetServiceConfig = Err.LastDllError
End If
CloseServiceHandle hSCManager
Else
GetServiceConfig = Err.LastDllError
End If
End Function
Public Function SetNTService() As Long '安装服务
Dim hSCManager As Long, hService As Long, DomainName As String
If Service_Account = "" Then Service_Account = "LocalSystem"
If Service_Account <> "LocalSystem" Then
'向用户帐号添加域名信息
If InStr(1, Service_Account, "\") = 0 Then
DomainName = GetDomainName()
If Len(DomainName) = 0& Then DomainName = "."
Service_Account = DomainName & "\" & Service_Account
End If
End If
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CREATE_SERVICE)
If hSCManager Then
'安装服务为自启动
hService = CreateService(hSCManager, StrPtr(Service_Name), _
StrPtr(Service_Display_Name), SERVICE_ALL_ACCESS, _
Service_Interact, _
Service_Type, SERVICE_ERROR_NORMAL, _
StrPtr(Service_File_Path), 0&, _
0&, 0&, StrPtr(Service_Account), _
StrPtr(Service_Password))
If hService Then
'向服务添加描述
ChangeServiceConfig2 hService, SERVICE_CONFIG_DESCRIPTION, StrPtr(Service_Description)
CloseServiceHandle hService
End If
CloseServiceHandle hSCManager
End If
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_START)
If hService Then
If StartService(hService, 0, 0) = 0 Then
End If
CloseServiceHandle hService
End If
CloseServiceHandle hSCManager
End If
End Function
Public Function DeleteNTService() As Long '卸载服务
Dim hSCManager As Long
Dim hService As Long, Status As SERVICE_STATUS
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
'如果服务运行着则先停掉它
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_ALL_ACCESS)
If hService Then
ControlService hService, SERVICE_CONTROL_STOP, Status
If DeleteService(hService) = 0 Then
DeleteNTService = Err.LastDllError
End If
CloseServiceHandle hService
Else
DeleteNTService = Err.LastDllError
End If
CloseServiceHandle hSCManager
Else
DeleteNTService = Err.LastDllError
End If
End Function
Public Function GetDomainName() As String '本地域名称
Dim lpBuffer As Long, l As Long, p As Long
If NetWkstaUserGetInfo(0&, 1&, lpBuffer) = 0 Then
CopyMemory p, ByVal lpBuffer + 4, 4
l = lstrlenW(p)
If l > 0 Then
GetDomainName = Space$(l)
CopyMemory ByVal StrPtr(GetDomainName), ByVal p, l * 2
End If
NetApiBufferFree lpBuffer
End If
End Function
Public Function StartNTService() As Long '开始服务
Dim hSCManager As Long, hService As Long
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_START)
If hService Then
If StartService(hService, 0, 0) = 0 Then
StartNTService = Err.LastDllError
End If
CloseServiceHandle hService
Else
StartNTService = Err.LastDllError
End If
CloseServiceHandle hSCManager
Else
StartNTService = Err.LastDllError
End If
End Function
Public Function StopNTService() As Long '停止服务
Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
hSCManager = OpenSCManager(0&, 0&, SC_MANAGER_CONNECT)
If hSCManager Then
hService = OpenService(hSCManager, StrPtr(Service_Name), SERVICE_STOP)
If hService Then
If ControlService(hService, SERVICE_CONTROL_STOP, Status) = 0 Then
StopNTService = Err.LastDllError
End If
CloseServiceHandle hService
Else
StopNTService = Err.LastDllError
End If
CloseServiceHandle hSCManager
Else
StopNTService = Err.LastDllError
End If
End Function
Public Property Let Name(ByVal sSrvName As String) '服务名称
Service_Name = sSrvName
End Property
Public Property Let DisplayName(ByVal sDisName As String) '显示名称
Service_Display_Name = sDisName
End Property
Public Property Let Description(ByVal sDes As String) '服务描述
Service_Description = sDes
End Property
Public Property Let Command(ByVal sSrvCmd As String) '执行参数
Service_File_Path = sSrvCmd
End Property
Public Property Let Account(ByVal sSrvAccount As String) '启动账户
If sSrvAccount <> "" Then Service_Account = sSrvAccount
End Property
Public Property Let Password(ByVal sSrvPassword As String) '账户密码
Service_Password = sSrvPassword
End Property
Public Property Let StartType(ByVal lType As SERVICE_START_TYPE) '启动类型
Service_Type = lType
End Property
Public Property Let Interact(ByVal lType As SERVICE_INTERACT_TYPE) '交互类型
Service_Interact = lType
End Property
Private Sub Class_Initialize()
If Service_Account = "" Then Service_Account = "LocalSystem"
End Sub