学习微软的NTSVC实现VB程序成为NT系统服务
2008-06-20 13:36:06
多数底层工作NTSVC都给我们完成了，NTSVC.hlp也提供了足够的编程接口，事件，方法，属性。
NTSVC示例
NTSVC示例
CODE:
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.Descrīption)
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.Descrīption
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.Descrīption
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.Descrīption
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.Descrīption
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.Descrīption
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.Descrīption
End Sub
nt_service.rar
(2008-06-20 13:34:57, Size: 36.8 kB, Downloads: 0)
论坛模式 推荐 收藏 等级(3) 编辑 管理 查看(635) 评论(10)
TAG:
-
weiyi75
发布于2008-10-30 23:13:19
-
打这么多注释还看不明白，都封装了，只调用就可以了。
api版本更复杂。
-
wlkstc发布于2008-10-30 21:51:47
-
楼主太强大了 我看不懂啊
-
xthyx发布于2008-10-24 19:13:51
-
顶一下！！
-
舍予发布于2008-10-24 15:46:02
-
值得一学
在VB这是个弱项
-
qiaodali发布于2008-10-15 19:26:00
-
恩，不错，用来做启动程序用得着，学习了！！！！
-
nxswxxg发布于2008-10-14 11:45:52
-
有没有简单点的
感觉有点复杂哦
-
chao8888发布于2008-09-18 20:20:38
-
看不到副件
-
weiyi75
发布于2008-06-20 20:56:49
-
en/ntservice.htm
instr 发现"en"
不久解析一下。
-
dolphins发布于2008-06-20 20:11:41
-
回复 #2 startbin321 的帖子
API版的
http://www.smsoft.ru/en/ntservice.htm
[ 本帖最后由 dolphins 于 2008-6-20 20:45 编辑 ]
vb6svc.zip
(2008-06-20 20:45:43, Size: 33.9 kB, Downloads: 63)
-
startbin321发布于2008-06-20 19:40:13
-
来个api版的就好了