Option Explicit
Private m_blnStopService As Boolean '服务是否已终止
Private Sub Form_Load()
On Error GoTo ERRPROC
Label1.Caption = "Loading"
NTService.DisplayName = "Sample NT Service" '服务管理器中的显示名称
NTService.ServiceName = "SampleService" '服务管理器中的服务名称
'安装服务
If Command = "/i" Then
NTService.Interactive = True '启用与桌面交互
'*********************************************************************************************************
'**“允许服务与桌面交互"指的是该服务提供某些交互界面,通过这些界面接受用户的某些设置,接收键盘鼠标消息等等
'** 然后该服务再根据用户输入的信息来配置服务如何运行,那么必须选中“允许服务与桌面交互”.
'** 一般情况下,不推荐“服务与桌面交互”,因为会带来一些隐患。
'*********************************************************************************************************
'作为 NT 服务安装程序
'三种模式
'svcStartAutomatic 自动
'svcStartDisabled 禁用
'svcStartManual 手动
NTService.StartMode = svcStartAutomatic
'读取安装状态
If NTService.Install Then
'在注册表中保存在 TimerInterval 参数
'[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\SampleService\Parameters]
'"TimerInterval"=hex(2):33,00,30,00,30,00,00,00
NTService.SaveSetting "Parameters", "TimerInterval", "300"
MsgBox NTService.DisplayName & ": 成功安装"
Else
MsgBox NTService.DisplayName & ": 安装失败"
End If
End
'删除服务注册表项并卸载服务
ElseIf Command = "/u" Then
If NTService.Uninstall Then
MsgBox NTService.DisplayName & ": 卸载成功"
Else
MsgBox NTService.DisplayName & ": 卸载失败"
End If
End
ElseIf Command <> "" Then
MsgBox "无效的参数"
End
End If
'TimerInterval存储的值为计时器时间间隔
Timer.Interval = CInt(NTService.GetSetting("Parameters", "TimerInterval", "300"))
'enable Pause/Continue. Must be set before StartService
'is called or in design mode
'启用暂停/继续。必须在StartService属性为之前或在设计模式中
'服务管理器的服务状态按钮下有四个按钮的有效性
'启动/停止/暂停/恢复
NTService.ControlsAccepted = svcCtrlPauseContinue
'服务连接到Windows NT服务控制器
NTService.StartService
Exit Sub
ERRPROC:
Call NTService.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub
'卸载该服务
Private Sub Form_Unload(Cancel As Integer)
'如果服务在运行中
If Not m_blnStopService 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 ERRPROC
Timer.Enabled = True
Label1.Caption = "Running"
Success = True
NTService.LogEvent svcEventInformation, svcMessageInfo, "Service continued"
Exit Sub
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
Private Sub NTService_Control(ByVal mEvent As Long)
'控制服务事件
On Error GoTo ERRPROC
Label1.Caption = NTService.DisplayName & " Control signal " & CStr([mEvent])
Exit Sub
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
Private Sub NTService_Pause(Success As Boolean)
'暂停事件请求
On Error GoTo ERRPROC
Timer.Enabled = False
Label1.Caption = "Paused"
NTService.LogEvent svcEventError, svcMessageError, "Service paused"
Success = True
Exit Sub
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
Private Sub NTService_Start(Success As Boolean)
'启动事件请求
On Error GoTo ERRPROC
Label1.Caption = "Running"
Success = True
Exit Sub
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
Private Sub NTService_Stop()
'停止并终止服务
On Error GoTo ERRPROC
Label1.Caption = "Stopped"
m_blnStopService = True
Unload Me
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
Private Sub Timer_Timer()
'当服务启动后运行这个过程
Dim sngX As Single
Dim sngY As Single
On Error GoTo ERRPROC
sngX = Me.Left + Rnd() * 100 - 50 '窗体左右晃动
sngY = Me.Top + Rnd() * 100 - 50
If sngY < 0 Then sngY = 0 '保证程序不出屏幕左上角
If sngX < 0 Then sngX = 0
If sngX > Screen.Width - Width Then sngX = Screen.Width - Width
If sngY > Screen.Height - Height Then sngY = Screen.Height - Height '保证程序不出屏幕右下角
Me.Move sngX, sngY
Exit Sub
ERRPROC:
NTService.LogEvent svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description
End Sub
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。