Access通过Microsoft.XMLHTTP获取软件最新版本号并实现软件有新版本需要更新的提醒(放在网站指定页面)

2017-08-13 19:23:00
zstmtony
原创
534

Access通过Microsoft.XMLHTTP获取软件最新版本号并实现软件有新版本需要更新的提醒

(最新版本号放在网站指定页面)


Access通用开发平台有一个检查平台最新版本与平台当前的版本对比,如果版本不一致,就提示用户有新版本,请更新

这个函数的源码现在分享给大家,大家可用在自己的Access数据库中。

这个函数的原理,就是在服务器的指定目录下放置一个 你的软件最新的版本号的文本文件,里面只有一个内容,版本号,如:1.0.0.1

如我将我的Access软件 的最新版本号放在网站上 这个路径:

http://www.office-cn.net/Version/newVer.txt


然后通过

Microsoft.XMLHTTP, 使用get 方法 来获取这个文本文件里的版本号的值,并返回给函数


这个函数调用非常方便。但需要注意

1.如果使用的电脑网络 连接不畅或网络 比较慢,或无法访问外网,函数会执行一段时间,如果网络 很慢的话,可能会花去比较长的时间

2.所以最好是在执行这个函数前再做一个ping的函数,判断网络 是否通。不通的话,就跳过这个版本判断 。网络 通的话,则判断


获取Access软件系统最新版本的通用函数的源码如下:


Public Function gf_CheckNewVer() As String
'检测新版本, 如果与本地版本不符,则提醒用户 有新版本
’Access中国通用开发平台 检查 最新版本的函数    
    On Error GoTo Err_Handler
  
    Dim lngStartTime As Long
    Dim lngTry As Long
    
    Dim h As Object
    Dim strCurrentVer  As String
    Dim strNewVer As String
    Dim strIniFile As String
 
    '有时连到下一页 提示出错 ,如果出错,就代码再尝试一次,2次出错且超时时间大于20秒就返回
    lngStartTime = Timer
      
NxtTry:
    On Error GoTo Err_Handler
 
    gf_CheckNewVer = ""

    Set h = CreateObject("Microsoft.XMLHTTP")
      

    h.Open "GET", "http://www.office-cn.net/Version/newVer.txt", False
    h.SetRequestHeader "If-Modified-Since", "0" '禁止缓存 

    h.Send     

    If h.Status = 200 Then  'h.readyState = 4 '这个有时也不准
        strNewVer = StrConv(h.responseBody, vbUnicode)
         
        Set h = Nothing
    Else
        Set h = Nothing
    End If
    Dim Customer As String
    Dim strCustCode As String
    Dim lngCustId As Long
    
 
    gf_CheckNewVer = strNewVer
    
 
    strCurrentVer = gstrVersion
 

Exit Function

Err_Handler:
    gf_CheckNewVer = ""
    Select Case Err.Number
    Case 5415
        lngTry = lngTry + 1 
        If lngTry < 2 And (Timer - lngStartTime) < 30 Then 
           GoTo NxtTry 
        End If 
    End Select End Function
分享