这里使用微软开发的vb组件:NTSVC.ocx 来实现,我制作了一个简化的模块,可以一键集成到你的vb程序,让你的程序实现后台系统服务的方式运行。如果不需要系统服务了,也可以直接删掉这个模块就完成了。
模块自带了一个服务管理窗口,可以实现服务安装和卸载,,日常维护可以控制服务启动和停止。后期可优化实现服务运行状态的显示。
需要用到的组件,在本文底部下载,记得先注册。
然后在 vb ide 引用控件
然后引入本服务模块(文末下载),并把启动对象设置为本窗口
只需要配置下本服务窗口的以下4个参数,就可以实现服务集成了。
而且在ide下,本服务窗口会自动启动你的业务主窗口,
就是你原来想要启动的第一个窗口,这是因为ide下不存在系统服务,所以
显示你的业务窗口,才不妨碍你继续开发和调试业务。
在编译后的 exe,双击启动会出现服务控制窗口(就是本文的第一个图片)
在计算机服务列表启动服务,才会真正的启动你的业务窗口,进行后台运行。
- 第一个参数是设置你希望服务启动的主要业务窗口
- 第二个参数是只你的主业务窗口是加载了窗口就运行还是有一个公开的 StartApp 函数启动的
- 后面几个参数是你希望在计算机服务列表显示的内容
源代码:
VERSION 5.00
Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "NTSVC.ocx"
Begin VB.Form SysService
BorderStyle = 1 'Fixed Single
Caption = "系统服务模块"
ClientHeight = 3015
ClientLeft = 150
ClientTop = 495
ClientWidth = 4560
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3015
ScaleWidth = 4560
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton ServiceAction
Caption = "卸载服务"
Height = 615
Index = 3
Left = 2640
TabIndex = 3
Top = 1800
Width = 1335
End
Begin NTService.NTService NTService1
Left = 3840
Top = 2520
_Version = 65536
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
ServiceName = "Simple"
StartMode = 2
End
Begin VB.Frame Frame1
Caption = "服务管理"
Height = 2775
Left = 120
TabIndex = 1
Top = 120
Width = 4335
Begin VB.CommandButton ServiceAction
Caption = "停止服务"
Height = 615
Index = 1
Left = 2520
TabIndex = 4
Top = 600
Width = 1335
End
Begin VB.CommandButton ServiceAction
Caption = "启动服务"
Height = 615
Index = 0
Left = 480
TabIndex = 0
Top = 600
Width = 1335
End
Begin VB.CommandButton ServiceAction
Caption = "安装服务"
Height = 615
Index = 2
Left = 480
TabIndex = 2
Top = 1680
Width = 1335
End
End
Begin VB.Menu OpenMainForm
Caption = "打开主窗口"
End
End
Attribute VB_Name = "SysService"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'作者:邓伟
'联系:QQ 215879458
'网站:http://vb6.pro
'说明:原创模块,转载请保留本注释块
'使用本窗口可解耦服务模块,给你的vb程序增加系统服务的功能很简单,
'修改工程属性的启动对象为本窗口,然后配置下本窗口的 Form_Load 即可
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim StartForm As VB.Form
Dim HasStartApp As Boolean
Private Sub Form_Load()
'设置业务启动窗口
Set StartForm = MainForm
'设置业务窗口是否有启动业务的函数
HasStartApp = True
'这里修改你需要的系统服务选项自定义:
With NTService1
.StartMode = svcStartAutomatic
.ServiceName = "EtcRtxMsg"
.DisplayName = "ETC-RTX消息推送服务"
End With
Call NTServiceAction
'设置好参数后启动服务
NTService1.StartService
'系统服务是编译exe后才有效的,所以ide下自动退出本窗口
If App.LogMode = 0 Then
StartForm.Show
Unload Me
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If App.LogMode <> 0 Then Unload StartForm
End Sub
Private Sub NTService1_Continue(Success As Boolean)
Success = True
End Sub
Private Sub NTService1_Pause(Success As Boolean)
Success = True
End Sub
Private Sub NTService1_Start(Success As Boolean)
Call StartForm.Show
If HasStartApp = True Then StartForm.StartApp
Success = True
End Sub
Private Sub NTService1_Stop()
Unload Me
End Sub
Private Sub NTServiceAction()
'判断是否安装或卸载
Select Case Command
Case "-i"
'NTService1.Interactive = True
If NTService1.Install Then
' Call NTService1.SaveSetting("Parameters", "TimerInterval", "1000") '系统参数存储
MsgBox "后台服务安装成功!"
Else
MsgBox "后台服务安装失败!可能服务已经安装?"
End If
End
Case "-u" '如果启动时带上 撤除参数
If NTService1.Uninstall Then
MsgBox "后台服务卸载成功!"
Else
MsgBox "后台服务卸载失败,可能服务已经卸载或者未安装?"
End If
End
Case "-start"
Shell "net start """ & NTService1.ServiceName & """"
MsgBox "已执行后台服务启动!"
End
Case "-stop"
Shell "net stop """ & NTService1.ServiceName & """"
MsgBox "已执行后台服务停止!"
End
End Select
End Sub
Private Sub OpenMainForm_Click()
Call StartForm.Show
End Sub
Private Sub ServiceAction_Click(Index As Integer)
Dim ActionName: ActionName = Array("-start", "-stop", "-i", "-u")
ShellExecute 0, "runas", App.EXEName, ActionName(Index), App.Path, vbNormalFocus
End Sub
好了,下载地址:
Views: 244