VB实现应用程序在局域网上自动更新

　　我们在用VB开发大型应用程序时遇到如下问题，进入调试、维护阶段开发小组进驻用户单位，软件交用户试用会经常修改程序并重新编译。然后再由程序员给用户复制更新，或者通知用户自行复制更新。对于少量用户可以做到及时更新。

　　而我们的一个用户在一座十层的大厦中办公，有十几个部门(即有管理部门又有生产车间分布在不同的楼层)，每个部门少则有2~3台工作站，多则有数十台工作站，与四台服务器组成局域网络.且每个部门应用程序各不相同，应用程序修改编译后经常不能同步更新，从而造成部门内数据或者部门间的数据不一致。程序员每天都要跑上跑下检查版本更新程序浪费了很多宝贵时间，即使通知部门主管自行更新，某些工作站也会出现遗漏现象。鉴于以上问题我们考虑使用程序自动更新技术，即自动检查新版本，将新版本复制到本地，重新执行本地应用程序。

　　基本原理：在某个服务器上共享出一个目录，其权限为程序员完全控制，其它用户只读。

　　例如:\\NtServer01\Refresh，程序员重新编译后的应用程序.EXE都存放在此目录下。

　　在应用程序的入口处调用版本检查及更新过程，如果服务器应用程序的修改时间大于本地应用程序的修改时间，则认为有新版本出现，应该将服务器上的新版本复制到本地硬盘。

　　由于应用程序在运行时不能被新版本覆盖，所以就需要中介程序FastCopy.EXE(也用VB编写)来完成更新版本并重新运行本地应用程序。为了达到及时更新的目的可在应用程序中每隔5分钟或10分钟检查一次是否有新版本。(此部分略有兴趣的读者可自行编程添加)

　　本例中:

　　服务器:NtServer01 共享目录: Refresh

　　应用程序:MyApp.exe 中介程序:FastCopy.exe (都存储于共享目录中)

　　具体程序实现如下:

　　在应用程序工程MyApp中的部分代码如下:

　　Option Explicit

　　'编译后的应用程序名称,注意没有后缀 .EXE,本例为MYAPP

　　Private Const App_Name = "MyApp"

　　'最新的应用程序存放的路径,本例为：服务器 NtServer01 共享目录 Refresh

　　Private Const ExePath = "\\NtServer01\Refresh\"

　　'中介程序名称,注意没有后缀 .EXE,本例为 FastCopy

　　Private Const MidExeName = "FastCopy"

　　'应用程序入口

　　Private Sub Form_Load()

　　If UCase(Trim(App.EXEName)) <>UCase(Trim(App_Name)) Then

　　MsgBox "必须将订单管理系统的名称更改为: " + App_Name

　　End

　　End If

　　'判断是否有最新版本的应用程序,如有则自动更新

　　Call ExeRefresh

　　'下面为订单管理系统的正常操作 略 ... ....

　　End Sub

　　'版本检查及更新过程

　　rivate Sub ExeRefresh()

　　'定义四个临时字符串变量

　　Dim s1 As String

　　Dim s2 As String

　　Dim s3 As String

　　Dim s4 As String

　　On Error Resume Next

　　'将本地应用程序MyApp.EXE的全路径名存入 s1

　　'将本地中介程序FastCopy.exe的全路径名存入 s3

　　s1 = "TNT"

　　If Len(App.Path) >3 Then

　　s1 = App.Path + "\" + Trim(App_Name) + ".exe"

　　s3 = App.Path + "\" + MidExeName + ".EXE"

　　Else

　　s1 = App.Path + Trim(App_Name) + ".exe"

　　s3 = App.Path + MidExeName + ".EXE"

　　End If

　　s4 = "TNT"

　　'将本地应用程序MyApp.EXE文件的修改时间存入 s4

　　s4 = FileDateTime(s1)

　　s2 = "TNT"

　　'将网络上应用程序MyApp.EXE文件的修改时间存入 s2

　　s2 = FileDateTime(ExePath + App_Name + ".EXE")

　　If s2 = "TNT" Then

　　MsgBox "没有找到最新的可执行文件:" + ExePath + App_Name + ".EXE" _ + vbCrLf + vbCrLf + "原因1:存放最新EXE的服务器或者工作站没有打开;" _ + vbCrLf + "原因2:存放最新EXE的路径错误或者EXE文件不存在;" _+ vbCrLf + "请将此情况通知程序员." + vbCrLf + vbCrLf _+ vbCrLf + "按确定按钮后,将继续运行本地EXE文件.", vbCritical, "提示"

　　End If

　　If s2 = "TNT" Or s4 = "TNT" Then Exit Sub

　　'如果网络上应用程序MyApp.EXE文件的修改时间,大于本地MyApp.EXE文件的修改时间

　　'然后再运行本地MyApp.EXE ,中介程序退出后,整个更新过程结束.

　　If CDate(s2) >CDate(s4) Then

　　'将网络上的中介程序FastCopy.exe复制到本地,这样可防止本地无中介程序时无法进行更新

　　FileCopy ExePath + MidExeName + ".EXE", s3

　　'则运行中介程序FastCopy.exe ,将最新的MyApp.EXE 复制到本地

　　s1 = Shell(s3 + " " + ExePath + "," + App_Name + ".EXE", vbNormalFocus)

　　'本地应用程序MyApp.EXE 终止运行,否则已经更新的MyApp.EXE无法覆盖本地的MyApp.EXE .

　　End

　　End If

　　End Sub

　　将以上程序编译为:MyApp.exe 存储在共享目录中.

　　在中介程序工程 FastCopy 中的代码如下:

　　向工程中增加一个窗体Form1 ,向Form1中添加一个定时器 Timer1 , 增加一个标签控件 Label1 ,其 Caption 为 "应用程序正在更新",并调整窗体大小.

　　Option Explicit

　　Private sPath As String '用于存储服务器上的共享目录

　　Private sName As String '用于存储应用程序名

　　Private Sub Form_Load()

　　Dim s As String

　　'从应用程序的命令行参数中取得数据

　　s = Trim(Command())

　　Dim p As Integer

　　p = InStr(1, s, ",")

　　If p >0 Then

　　'取得储服务器上的共享目录

　　sPath = Mid(s, 1, p - 1)

　　'取得应用程序名

　　sName = Mid(s, p + 1, Len(s) - p)

　　'定时器延时6秒,保证本地旧版应用程序退出运行

　　Timer1.Interval = 6000

　　Else

　　'参数错误则退出

　　MsgBox "Error", vbCritical, ""

　　Unload Me

　　End

　　End If

　　End Sub

　　'定时器代码

　　rivate Sub Timer1_Timer()

　　imer1.Interval = 0

　　Dim s1 As String

　　取得应用程序的本地路径

　　If Len(App.Path) >3 Then

　　s1 = App.Path + "\" + sName

　　lse

　　s1 = App.Path + sName

　　End If

　　保证服务器关机或者路径错误仍可运行旧版本

　　On Error Resume Next

　　'将服务器共享目录中的最新版本复制到本地

　　FileCopy sPath + sName, s1

　　Dim a As Long

　　'执行本地的应用程序

　　a = Shell(s1, vbNormalFocus)

　　'中介程序退出运行,应用程序自动更新结束

　　Unload Form1

　　End

　　End Sub

　　将工程 FastCopy 编译为FastCopy.exe 并存储于服务器的共享目录。

　　测试:

　　1、 将服务器共享目录中的：MyApp.exe 复制到本地硬盘的某个目录中；

　　2、 重新编译MyApp工程，将MyApp.exe复制到服务器的共享目录中，注意一定不要覆盖本地的MyExe.app ;

　　3、 这样服务器上MyApp.exe 的修改时间肯定大于本地MyApp.exe的修改时间;

　　4、 运行本地MyApp.exe ,几秒钟后屏幕上会出现"应用程序正在更新"的窗体，随后更新后应用程序再次被运行。则自动更新成功。

　　5、 程序的修改时间可通过在文件上用鼠标按右键的属性或内容的菜单观察。

　　本程序在Windows 98和 VB 6.0 ,NT局域网络下测试通过。

　　本文内容也适用于其它语言参考。