Access通過Microsoft.XMLHTTP穫取軟件最新版本號併實現軟件有新版本需要更新的提醒(放在網站指定頁麵)

2017-08-13 19:23:00
zstmtony
原創
815

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
分享