这里使用微软开发的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: 272

Hi, I’m 邓伟(woeoio)

本来无一物,何处惹尘埃

发表回复