注意:是类模块,不是模块。别搞错了。

用法:

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