【VB技巧】使用 NTSVC.ocx 控件做系统服务

Private Sub NT_Start(Success As Boolean) '服务开始事件请求
    Success = True
End Sub
Private Sub NT_Pause(Success As Boolean) '服务暂停事件
    NT.LogEvent svcEventError, svcMessageError, "Service paused"
    Success = True
End Sub
Private Sub NT_Continue(Success As Boolean) '服务继续
    Success = True
    NT.LogEvent svcEventInformation, svcMessageInfo, "Service continued"
End Sub
Private Sub NT_Control(ByVal mEvent As Long) '控制服务活动
End Sub
Private Sub NT_Stop() '停止和终止本服务
End Sub
Private Sub Form_Load()
NT.ControlsAccepted = svcCtrlPauseContinue
NT.StartService
End Sub

使用这个控件注册成Service服务的时候有个需要注意的，如果我们不使用/i或者/u参数，那么建立的Service服务会因为超时而不能启动。所以在注册Service服务的时候，必须带/i或/u参数。

1. 引用控件
选择“工程”－“引用”－“Microsoft NT Service Control”，如果没有，请先将NTSVC.OCX拷贝到%System32%/下，然后再引用对话框中选择浏览，添加该控件。

2. 主要代码
Private Sub Form_Load()
    On Error GoTo ServiceError
    '安装Service服务
    If Command = "/i" Then
        NTService.Interactive = True
        If NTService.Install Then
            NTService.SaveSetting "Parameters", "TimerInterval", "300"
            MsgBox NTService.DisplayName & ": installed successfully"
        Else
            MsgBox NTService.DisplayName & ": failed to install"
        End If
        End
    '删除Service服务
    ElseIf Command = "/u" Then
        If NTService.Uninstall Then
            MsgBox NTService.DisplayName & ": uninstalled successfully"
        Else
            MsgBox NTService.DisplayName & ": failed to uninstall"
        End If
        End
    End If
    Timer.Interval = CInt(NTService.GetSetting("Parameters", "TimerInterval", "300"))
    NTService.ControlsAccepted = svcCtrlPauseContinue
    NTService.StartService
    Exit Sub
ServiceError:
    Call NTService.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

'Unload the Service
Private Sub Form_Unload(Cancel As Integer)
    If Not StopService Then
        If MsgBox("Are you sure you want to unload the service?..." & vbCrLf & "the service will be stopped", vbQuestion + vbYesNo, "Stop Service") = vbYes Then
            NTService.StopService
            Label1.Caption = "Stopping"
            Cancel = True
        Else
            Cancel = True
        End If
    End If
End Sub

Private Sub NTService_Continue(Success As Boolean)
    On Error GoTo ServiceError
    Timer.Enabled = True
    Success = True
    NTService.LogEvent svcEventInformation, svcMessageInfo, "Service continued"
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Control(ByVal mEvent As Long)
    On Error GoTo ServiceError
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Pause(Success As Boolean)
    On Error GoTo ServiceError
    Timer.Enabled = False
    NTService.LogEvent svcEventError, svcMessageError, "Service paused"
    Success = True
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Start(Success As Boolean)
    On Error GoTo ServiceError
    Success = True
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Stop()
    On Error GoTo ServiceError
    StopService = True
    Unload Me
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

3. 如果是有其他的控件触发Service服务的Install和Uninstall,可以采用Shell或者WinExec来处理。
先声明函数
Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Public Const SW_HIDE = 0
使用，比如用CheckBox触发
a.安装
Call WinExec(App.EXEName & " /i", SW_HIDE)

b.卸载
Call WinExec(App.EXEName & " /u", SW_HIDE)

Private Sub NTService_Continue(Success As Boolean)
    On Error GoTo ServiceError
    Success = True
    NTService.LogEvent svcEventInformation, svcMessageInfo, "Service continued"
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Control(ByVal mEvent As Long) '控制服务活动
    On Error GoTo ServiceError
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Pause(Success As Boolean) '服务暂停事件
    On Error GoTo ServiceError
    NTService.LogEvent svcEventError, svcMessageError, "Service paused"
    Success = True
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Start(Success As Boolean) '服务开始事件请求
    On Error GoTo ServiceError
    Success = True
    Exit Sub
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

Private Sub NTService_Stop() '停止和终止本服务
    On Error GoTo ServiceError
    StopService = True
    Unload Me
ServiceError:
    NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub

文章目录