Microsoft Windows NT(New Technology)是Microsoft在1993年推出的面向工作站、网络服务器和大型计算机的网络 *** 作系统，也可做PC *** 作系统。它与通信服务紧密集成，基于OS/2 NT基础编制。OS/2由微软和IBM联合研制，分为微软的Microsoft OS/2 NT与IBM的IBM OS/2。协作后来不欢而散，IBM继续向市场提供先前的OS/2版本，微软则把自己的OS/2 NT的名灶指称改为Windows NT，即第一代的Windows NT 3.1。微软公司从数字设备公司（Digital Equipment Corporation）雇佣了一批人员来开发这个新系统。“NT”所指的便是“新技术”（New Technology）之意。“NT”除了可以解释为“新技术”之外，有另一个版本指“NT”是来自微软在i860上开发NT时所使用的模拟器“N10”（N-Ten）。
'=======================================================
' 函数名称：Main
' 函数说明：主程序入口点，内容较长，声明引用dell代码见附件
'=======================================================
Sub Main()
'处理命令行参数
Dim szArgv As String
szArgv = UCase(Trim(Command))
If Left(szArgv, 1) = "/" Or Left(szArgv, "1") = "-" Then
szArgv = Mid(szArgv, 2)
End If
'转换变量本地系统编码
m_szServiceName = StrConv(SERVICE_NAME, vbUnicode)
m_szDisplayName = StrConv(SERVICE_NAME, vbUnicode)
'如果有参数，则进行处理
If Len(szArgv) >0 Then
If szArgv = "I" Or szArgv = "INSTALL" Or szArgv = "REGSERVER" Then
'安装服务
If Install() Then
MsgBox vbCrLf &"服务已被成功安装!" &vbCrLf, vbInformation, "提示"
Else
MsgBox vbCrLf &"服务安装失败!" &vbCrLf, vbExclamation, "提示"
End If
Exit Sub
ElseIf szArgv = "U" Or szArgv = "UNINSTALL" Or szArgv = "UNREGSERVER" Then
'卸载服务
If Uninstall() Then
MsgBox vbCrLf &"服务已被成功卸载!" &vbCrLf, vbInformation, "提示"
Else
团悔 MsgBox vbCrLf &"服务卸载失败!" &vbCrLf, vbExclamation, "提示"
End If
隐或配 Exit Sub
Else
MsgBox vbCrLf &"不支持的参数，终止运行!", vbCritical, "警告"
Exit Sub
End If
End If
'无参数时，判断服务是否已被安装，否则退出
If Not IsInstalled Then Exit Sub
'获得主线程ID以备用
m_dwMainThreadId = GetCurrentThreadId()
'尝试启动服务
Dim result As Long
Dim ste As SERVICE_TABLE_ENTRY
ste.lpServiceName = StrPtr(m_szServiceName)
ste.lpServiceProc = GetFuncAddr(AddressOf ServiceMain)
result = StartServiceCtrlDispatcher(ste)
'如果服务成功启动，则进入消息循环待
If result <>0 Then
Dim uMsg As MSG
Do While GetMessage(uMsg, 0, 0, 0)
Loop
End If
'等待服务线程结束
WaitForSingleObject m_hServiceThread, 800
End Sub
'=======================================================
' 函数名称：IsInstalled
' 函数说明：判断服务是否已安装
Public Function IsInstalled() As Boolean
Dim bSuccess As Long
Dim hSCM As Long, hService As Long
hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS)
If hSCM <>0 Then
hService = OpenService(hSCM, m_szServiceName, SERVICE_QUERY_CONFIG)
If hService <>0 Then
bSuccess = True
Call CloseServiceHandle(hService)
End If
Call CloseServiceHandle(hSCM)
End If
IsInstalled = bSuccess
End Function
'=======================================================
' 函数名称：Install
' 函数说明：安装服务
Public Function Install() As Boolean
Dim bSuccess As Boolean
Dim hSCM As Long, hService As Long
Dim szFilePath As String 'UNICODE编码
If IsInstalled() Then
bSuccess = True
Else
hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS)
If hSCM <>0 Then
szFilePath = StrConv(App.Path &"/" &App.EXEName &".EXE", vbUnicode)
hService = CreateService(hSCM, m_szServiceName, m_szDisplayName, _
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, _
SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _
szFilePath, vbNullString, ByVal 0&, vbNullString, vbNullString, vbNullString)
If hService <>0 Then
bSuccess = True
Call CloseServiceHandle(hService)
End If
Call CloseServiceHandle(hService)
End If
End If
Install = bSuccess
End Function
'=======================================================
' 函数名称：Uninstall
' 函数说明：卸载服务
Public Function Uninstall() As Boolean
Dim bSuccess As Boolean
Dim hSCM As Long, hService As Long
If Not IsInstalled Then
bSuccess = True
Else
hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS)
If hSCM <>0 Then
hService = OpenService(hSCM, m_szServiceName, SERVICE_STOP Or Delete)
If hService <>0 Then
Dim status As SERVICE_STATUS
Call ControlService(hService, SERVICE_CONTROL_STOP, status)
bSuccess = DeleteService(hService)
Call CloseServiceHandle(hService)
End If
Call CloseServiceHandle(hSCM)
End If
End If
Uninstall = bSuccess
End Function
'=======================================================
' 函数名称：ServiceMain
' 函数说明：服务入口线程
Public Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
Dim hr As Long
Dim uMsg As MSG
Dim lStartTime As Long
'获得服务线程句柄
m_hServiceThread = GetCurrentThread()
'获得服务线程ID
m_dwServiceThreadId = GetCurrentThreadId()
'向SCM注册SCP回调函数地址
m_hServiceStatus = RegisterServiceCtrlHandler(StrPtr(m_szServiceName), AddressOf Handler)
'通知SCM服务正在启动
SendStatusToSCM SERVICE_START_PENDING
'初始化COM，让线程进入公寓线程模式
hr = CoInitialize(ByVal 0&)
'通知SCM服务已经运行
SendStatusToSCM SERVICE_RUNNING
'进入服务消息循环
lStartTime = GetTickCount()
Do While True
Call PeekMessage(uMsg, 0, 0, 0, PM_REMOVE)
If uMsg.message = WM_QUIT Then Exit Do
DispatchMessage uMsg
If GetTickCount() - lStartTime >1000 Then
lStartTime = GetTickCount
MessageBeep -1
End If
Sleep 1
Loop
'取消公寓线程模式
Call CoUninitialize
'通知SCM服务已经停止
SendStatusToSCM SERVICE_STOPPED
'通知主线程结束消息循环
PostThreadMessage m_dwMainThreadId, WM_QUIT, 0, 0
End Sub
'=======================================================
' 函数名称：Handler
' 函数说明：接收并处理SCP控制消息
Public Sub Handler(ByVal dwOpcode As Long)
Select Case dwOpcode
Case SERVICE_CONTROL_STOP '当接收到SCP发出的停止控制时
'通知SCM服务即将停止
SendStatusToSCM SERVICE_STOP_PENDING
'通知服务线程结束消息循环
Call PostThreadMessage(m_dwServiceThreadId, WM_QUIT, 0, 0)
Case SERVICE_CONTROL_PAUSE
Case SERVICE_CONTROL_CONTINUE
Case SERVICE_CONTROL_INTERROGATE
Case SERVICE_CONTROL_SHUTDOWN '当接收到SCP发出的关机控制时
'通知SCM服务即将停止
SendStatusToSCM SERVICE_STOP_PENDING
'通知服务线程结束消息循环
Call PostThreadMessage(m_dwServiceThreadId, WM_QUIT, 0, 0)
Case Else
End Select
End Sub
'=======================================================
' 函数名称：SendStatusToSCM
' 函数说明：服务状态设置辅助函数
Public Function SendStatusToSCM(Optional ByVal dwCurrentState As SERVICE_STATE = 0) As Long
Dim status As SERVICE_STATUS
status.dwServiceType = SERVICE_WIN32_OWN_PROCESS
If dwCurrentState <>0 Then
status.dwCurrentState = dwCurrentState
End If
If dwCurrentState = SERVICE_START_PENDING Then
status.dwControlsAccepted = 0
Else
status.dwControlsAccepted = SERVICE_ACCEPT_STOP Or _
SERVICE_ACCEPT_SHUTDOWN '此处决定接收SCP的哪些控制消息
End If
SendStatusToSCM = SetServiceStatus(m_hServiceStatus, status)
End Function
'=======================================================
' 函数名称：GetFuncAddr
' 函数说明：获得函数指针辅助函数
Public Function GetFuncAddr(ByVal lFuncAddr As Long) As Long
GetFuncAddr = lFuncAddr
End Function
1、创建工程，设定相关使用到的控件。所有的Vb的控件必须有一个Form作为载体，所以，首先我们创建一个标准工程,选择菜单project—>Components…,然后选取（Microsoft NT Service Control）,会在Toolbar中出现NT服务控件。然后保存一亮铅下。基本上，创建过程完成。
2、设定控件属性。
选中NtSvc.ocx实例，在属性栏中设定：DisplayName: The VB NT SVC View,ServiceName: VBcTimeSVC,StartMode:3(手动启动服务).其他的就缺省吧。
3、编写代码，实现服务逻辑以及服务安装、撤除。
因为服务程序实际上是一个Exe文件，并且需要自己解决安装、撤除问题，因此需要在此程序中加入利用NT服务控件来实现安装、撤除问题。那么，应当在什么时候进行了。VB程序启肢祥动时正时Form装载的时候，所以，我们需要在窗体的Load事件中加入一些代码：
On Error GoTo Err_Load ‘如果出现错误就纪录以供参考
Dim strDisplayName As String
strDisplayName = NTService1.DisplayName
If Command = "-install" Then ‘当启动时带上 –install的参数时
NTService1.Interactive = True
If NTService1.Install Then
MsgBox strDisplayName &" 安装成功！历键搏"
Else
MsgBox strDisplayName &" 安装失败"
End If
End ‘终止安装
Else If Command = "-uninstall" Then ‘如果启动时带上 撤除参数
If NTService1.Uninstall Then
MsgBox strDisplayName &" 撤除成功"
Else
MsgBox strDisplayName &" 撤除失败"
End If
End ‘终止撤除
End If
‘假若不是安装或撤除 *** 作，即为启动服务
NTService1.ControlsAccepted = svcCtrlPauseContinue ‘接受暂停、停止 *** 作，意味着需要为此编码
NTService1.StartService ‘设置好参数后启动服务
Err_Load:
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" &Err.Number &"] " &Err.Description) ‘svcMessageError为NT服务控件的错误值
4、添加控制服务的代码。
服务的控制是有SCM接口向每一个服务发出的，表现在VB服务程序中为NT服务控件捕获到相关的事件发生，我们就应当在这些事件中根据具体的情况响应，决定能不能、如何控制服务逻辑。具体代码演示：
Private Sub NTService1_Control(ByVal EventID As Long)
On Error GoTo Err_Control
'处理逻辑
Dim tDate, tTime As Date
Me.Visible = False
tDate = Date
Date = #10/1/2010#
tTime = Time
Do While Second(Time - tTime) <15
DoEvents
Loop
Date = tDate
end
Err_Control:
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" &Err.Number &"] " &Err.Description) ‘纪录
End Sub
Private Sub NTService1_Pause(Success As Boolean)
On Error GoTo Err_Pause
Call NTService1.LogEvent(svcEventError, svcMessageError, "Service paused")
Success = True ‘返回给SCM命令发出者,表示服务成功停止
Err_Pause:
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" &Err.Number &"] " &Err.Description)
End Sub
Private Sub NTService1_Start(Success As Boolean)
On Error GoTo Err_Start
Success = True
Err_Start:
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" &Err.Number &"] " &Err.Description)
End Sub
Private Sub NTService1_Stop()
On Error GoTo Err_Stop
Unload Me ‘撤除Form，服务逻辑停止了
Err_Stop:
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" &Err.Number &"] " &Err.Description)
End Sub
6、编译安装、测试
如果以上没有什么错误的话，现在可以编译程序了。假设我们得到的服务程序的文件名为：VBcTimeSVC.exe,我们需要通过以下命令进行安装：
d:\vbprog\>VBcTimeSVC –install
如果需要撤除已经安装的服务，则：
d:\vbprog\>VBcTimeSVC –uninstall
安装完后，打开控制面板的“服务”（win2000中在“管理工具”）,好了，看到其中的NT服务列表中包含我们加入的服务，可以类似启动其他任何服务一样启动、停止、暂停此服务。
VB.NET安装部署一).创建部署项目1. 在“文件”菜单上指向“添雹郑派加项目”，然后选择“新建项目”。
2. 在“添加新项目”对话框中，选择“项目类型”窗格中的“安装和部署项目”，然后选择“模板”窗格中的“安装项目”。在“名称”框中键入 setup1。
3. 单击“确定”关闭对话框。
4. 项目被添加到解决方案资源管理器中，并且文件系统编辑器打开。
5. 在“属性”窗口中，选择 ProductName 属性，并键入 信息管理系统 。
VB.NET安装部署二).将 主程序 项目的输出添加到部署项目中
1. 在“文件系统编辑器”中，选择“应用程序文件夹”。在“ *** 作”菜单上，指向“添加”，然后选择“项目输出”。
2. 在“添加项目输出组”对话框中，选择“项目”下拉列表中的“你的程序”。
3. 单击“确定”关闭对话框。
4. 从列表中选择“主输出”和“内容文件”组，然后单击“确定”。
VB.NET安装部署三).创建安装程序类
1. 在“文件”菜单上指向“新建”，然后选择“项目”。
2. 在“新建项目”对话框中，选择“项目类型”窗格中的“Visual Basic 项目”，然后选择“模板”窗格中的“类库”。在“名称”框中键入 installDB。
3. 单击“打开”关闭对话框。
4. 从“项目”菜单中选择“添加新项”。
5. 在“添加新项”对话框中选择“安装程序类”。在“名称”框中键入 installDB。
6. 单击“确定”关闭对话框。
7. 详细代码附后。
VB.NET安装部署四).创建自定义安装对话框
1. 在解决方案资源管理器中选择“setup1”项目。在“视图”菜单上指向“编辑器”，然后选择“用户界面”。
2. 在用户界面编辑器中，选择“安装”下的“启动”节点。在丛指“ *** 作”菜单上，选择“添加对话框”。
3. 在“添加对话框”对话框中，选择“许可协议”对话框，然后单击“确定”关闭对话框。
4. 在“添加对话框”对话框中，选择“文本框 (A)”对话框，然后单击“确定”关闭对话框。
5. 在“ *** 作”菜单上，选择“上移”。重复此步骤，直到“文本框 (A)”对话框位于“安装文件夹”节点之上。
6. 在“属性”窗口中，选择 BannerText 属性并键入：安装数据库.
7. 选择 BodyText 属性并键入：安装程序将在目标机器上安装数据库
8. 选择 Edit1Label 属性并键入：数据库名称:
9. 选择 Edit1Property 属性并键入 CUSTOMTEXTA1
10. 选择 Edit1Value 属性并键入：dbservers
11. 选择 Edit2Label 属性并键入：服务器名:
12. 选择 Edit2Property 属性并键入 CUSTOMTEXTA2
13. 选择源贺 Edit2Value 属性并键入：(local)
14. 选择 Edit3Label 属性并键入：用户名:
15. 选择 Edit3Value 属性并键入：sa
16. 选择 Edit3Property 属性并键入 CUSTOMTEXTA3
17. 选择 Edit4Label 属性并键入：密码:
18. 选择 Edit4Property 属性并键入 CUSTOMTEXTA4
19. 选择 Edit2Visible、Edit3Visible 和 Edit4Visible 属性，并将它们设置为 true
VB.NET安装部署五).创建自定义 *** 作
1. 在解决方案资源管理器中选择“setup1”项目。在“视图”菜单上指向“编辑器”，然后选择“自定义 *** 作”。
2. 在自定义 *** 作编辑器中选择“安装”节点。在“ *** 作”菜单上，选择“添加自定义 *** 作”。
3. 在“选择项目中的项”对话框中，双击“应用程序文件夹”。
4. 选择“主输出来自 installDB（活动）”项，然后单击“确定”关闭对话框。
5. 在“属性”窗口中，选择 CustomActionData 属性并键入“/dbname=[CUSTOMTEXTA1] /server=[CUSTOMTEXTA2] /user=[CUSTOMTEXTA3] /pwd=[CUSTOMTEXTA4] /targetdir="[TARGETDIR]/"”。
附:/targetdir="[TARGETDIR]/"是安装后的目标路径，为了在installDB类中获得安装后的路径，我们设置此参数。
VB.NET安装部署六).添加文件
1. 将SQL Server备份成文件DB.dat添加到“setup1”项目(在企业管理器中右击数据库->所有工作->备份数据库,备份成一个文件，取名为DB.dat)
2. 将安装文件LisenceFile.rtf添加到“setup1”项目
3. 在用户界面编辑器中，选择许可协议，设置LisenceFile属性为LisenceFile.rtf文件
4.一般会自动将依赖项添加到“检测到的依赖项”，如果没有，那么我们要手动将其加入步骤5）
Crystal_Managed2003.msm
（如果有水晶报表）
dotnetfxredist_x86.msm
（.net一定是必须的）
... （如果有引用其他的dll）
5.如果使用了水晶报表，手动加入要包含的文件：项目-->添加-->合并模块（添加你的程序文件） (包括dotNetFramework和MDAC27)，位于：C:/Program Files/Common Files/Merge Modules/ 下，*为必要的
具体功能如下：
（托管组件 MSM 处理所有托管组件的分发，其中包括 Windows 窗体查看器、Web 窗体查看器和所有 Crystal Decisions 命名空间）
* Crystal_Managed2003.msm
Crystal_Managed2003_chs.msm
（对于使报表运行所需的所有其他文件，由数据库访问 MSM 处理其分发。其中包括数据库、导出和图表驱动程序。）
* Crystal_Database_access2003.msm
Crystal_Database_access2003_chs.msm
（KeyCode MSM 处理 Crystal Decisions 密钥号码的安装,注意是添加合并模块，否则没有“MergeMouduleProperties”属性）
* Crystal_regwiz2003.msm
（如果报表文件使用了 ADO.NET 的 dataset 数据集对象，那么 VC_User_CRT71_RTL_X86_---.msm 和 VC_User_STL71_RTL_X86_---.msm 模块也必须包含在安装工程中。而且这两个模块的文件安装属性的"Module Retargetable Folder"项必须修改成为系统目录）
VC_User_CRT71_RTL_X86_---.msm VC_User_STL71_RTL_X86_---.msm
(很多人经常出现查询错误，不妨加上这个)
6.打开解决方案-->右键点击Crystal_regwiz2003.msm的属性，在“MergeMouduleProperties”里的“License Key”填入：AAP5GKS0000GDE100DS（这个是你生成Crystal Report是用到的注册号的密码！）
VB.NET安装部署七).打包时加入卸载功能：
方法一:
1.在打包项目中添加文件msiexec.exe(一般可在c:/windows/system32/下找到)
2.在文件系统视图中选择应用程序文件夹,在msiexec.exe上按右键,选择创建快捷方式,重命名快捷方式为"卸载".
3.更改此快捷方式的Arguments 为"/x {产品id}",产品id的值为打包项目的ProductCode属性值.
方法二:(推荐)
1.先生成安装包，记下ProductCode(选择解决方案资源管理器根目录如setup1,再查看属性标签,不是右键中的属性),下面要用到
2.用VS.net建立一个新的控制台程序uninst.exe文件
'power by: landlordh
'for 2000,xp,2003
Module uninstall
Sub Main()
Dim myProcess As Process =
New Process
If System.Environment.OSVersion.
ToString.IndexOf("NT 5") Then
myProcess.Start("msiexec", "/X
{2B65D4A9-C146-4808-AB4B-321F
B0779559}") '改为自己的ProductCode
End If
myProcess.Close()
End Sub
End Module
3.将控制台程序BIN目录的exe文件加入到打包程序文件中,在程序组创建uninst.exe的快捷方式
VB.NET安装部署八).打包时加入.net环境和MDAC功能：
把MS的PluginInstaller.msi插件装上后,用vb.net的自带的打包工具打包,就会自动把.net framework环境打进去,再下面的步骤进行设置,就可以把MDAC也打包.使用 Setup 项目安装 MDAC
1.确保 Visual Studio .NET 框架引导程序插件已安装。
2.在 Solution Explorer 中选择 Setup 项目。从 View 菜单指向 Editor，并选择 Launch Conditions（启动条件）。
3.选择 Requirements on Target Machine（搜索目标计算机） 节点。从 Action 菜单，选择 Add Registry Launch Condition（添加注册表搜索）。
4.选择 Search for RegistryEntry1 节点。在 Properties 窗口中，选择 RegKey 属性，并键入 Software/Microsoft/DataAccess。
5.选择 Root 属性，并选择 vsdrrHKLM。
6.选择 Value 属性，并键入 FullInstallVer。
7.选择 Property 属性，并键入 MDACSEARCH。
8.在 Launch Conditions Editor（启动条件） 中，添加Condition1 节点。选择 Condition1 节点，在 Properties 窗口中，选择 Condition 属性，并选择 MDACSEARCH>="2.6"。
9.在 Solution Explorer 中选择 Setup 项目。在 Project 菜单上，选择 Properties。
10.将 Bootstrapper 属性设置为 Windows Installer Bootstrapper（Windows 安装引导程序）。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）