在局域网上实现自动升级源程序

时　间:2007-10-24 22:49:45
作　者:bamboo   ID：8  城市：上海  QQ：2851379730
摘　要:为祝贺本人获得2007年度微软最有价值专家(MVP)特分享本程序，您可以免费使用本程序，但请保留作者信息，如果您有更好的建议，请与我联系!
正　文:

(Q)如何在局域网上实现自动升级？

(A)
1.建一个启动程序log_on.mdb

2.判断本地主程序与服务器端主程序的版本是否一致
  采用GetVersion函数来获得版本号
Public Function GetVersion(FileName As String, strPWS As String) As String
    Dim rst As ADODB.Recordset
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & FileName & ";jet oledb:database password='" & strPWS & "'"
    strSQL = "select * from tblversion"
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseClient
    rst.Open strSQL, strConn
    rst.MoveFirst
    GetVersion = rst!Version
    rst.Close
    Set rst = Nothing
End Function 

3.将服务器端的主程序替换本地主程序
    Dim SourceFile As String
    Dim DestinationFile As String
    Dim localVision As String
    Dim serverVision As String
    ' 指定服务器上的文件名。
    ' SourceFile = "\\172.16.172.6\server\main.mdb"
    SourceFile = CurrentProject.Path + "\server\main.mdb"
    ' 指定本地文件名。
    DestinationFile = CurrentProject.Path + "\main.mdb"
    If Dir(SourceFile) = "" Then
        MsgBox SourceFile & vbCrLf & "网路不通或文件不存在!", vbCritical, "提示"
        Exit Sub
    End If
    '获得本地主程序的版本号
    localVision = GetVersion(DestinationFile, "")
    '获得服务器端升级文件的版本号
    serverVision = GetVersion(SourceFile, "")
    If localVision = serverVision Then
        '运行主程序
        OpenDB
    Else
        MsgBox "版本不同，现在开始升级!", vbInformation, "提示"
        FileCopy SourceFile, DestinationFile
        MsgBox "版本升级结束!", vbInformation, "提示"
        '运行主程序
        OpenDB
    End If

4.替换结束后运行主程序
Public Sub OpenDB()
    Dim strDB As String
    strDB = CurrentProject.Path & "\main.mdb"
    Set appAccess = CreateObject("Access.Application")
    Set db = appAccess.DBEngine.OpenDatabase(strDB, False, False, ";PWD=")
    appAccess.OpenCurrentDatabase strDB
    If Val(SysCmd(acSysCmdAccessVer)) = 9 Then
        appAccess.Visible = True
    End If
    DoCmd.Quit
End Sub

示例下载:点击这里下载