<% Rem ##################################################################################### Rem ## 在線升級類聲明 Class Cls_oUpdate Rem ################################################################# Rem ## 描述: asp 在線升級類 Rem ## 版本: 1.0.0 Rem ## 作者: 蕭月痕 Rem ## MSN: xiaoyuehen(at)msn.com Rem ## 請將(at)以 @ 替換 Rem ## 版權: 既然共享, 就無所謂版權了. 但必須限于網絡傳播, 不得用于傳統媒體! Rem ## 如果您能保留這些說明信息, 本人更加感謝! Rem ## 如果您有更好的代碼優化, 相關改進, 請記得告訴我, 非常謝謝! Rem ################################################################# Public LocalVersion, LastVersion, FileType Public UrlVersion, UrlUpdate, UpdateLocalPath, Info Public UrlHistory PRivate sstrVersionList, sarrVersionList, sintLocalVersion, sstrLocalVersion Private sstrLogContent, sstrHistoryContent, sstrUrlUpdate, sstrUrlLocal Rem ################################################################# Private Sub Class_Initialize() Rem ## 版本信息完整URL, 以 http:// 起頭 Rem ## 例: http://localhost/software/Version.htm UrlVersion = ""
Rem ## 本地更新目錄, 以 / 起頭, /結尾. 以 / 起頭是為當前站點更新.防止寫到其他目錄. Rem ## 程序將檢測目錄是否存在, 不存在則自動創建 UpdateLocalPath = "/"
Rem ## 生成的軟件歷史文件 UrlHistory = "history.htm"
Rem ## 最后的提示信息 Info = ""
Rem ## 當前版本 LocalVersion = "1.0.0"
Rem ## 最新版本 LastVersion = "1.0.0"
Rem ## 各版本信息文件后綴名 FileType = ".asp" End Sub Rem #################################################################
Rem ################################################################# Private Sub Class_Terminate()
End Sub Rem ################################################################# Rem ## 執行升級動作 Rem ################################################################# Public function doUpdate() doUpdate = False
Rem ## 升級網址檢測 If (Left(UrlVersion, 7) <> "http://"<IMG SRC="smile/05.gif"> Or (Left(UrlUpdate, 7) <> "http://"<IMG SRC="smile/05.gif"> Then Info = "版本檢測網址為空, 升級網址為空或格式錯誤(#1)" Exit function End If
If Right(UrlUpdate, 1) <> "/" Then sstrUrlUpdate = UrlUpdate & "/" Else sstrUrlUpdate = UrlUpdate End If
If Right(UpdateLocalPath, 1) <> "/" Then sstrUrlLocal = UpdateLocalPath & "/" Else sstrUrlLocal = UpdateLocalPath End If
Rem ## 版本檢測(初始化版本信息, 并進行比較) If IsLastVersion Then Exit function
Rem ## 開始升級 doUpdate = NowUpdate() LastVersion = sstrLocalVersion End function Rem #################################################################
Rem ## 檢測是否為最新版本 Rem ################################################################# Private function IsLastVersion() Rem ## 初始化版本信息(初始化 sarrVersionList 數組) If iniVersionList Then Rem ## 若成功, 則比較版本 Dim i IsLastVersion = True For i = 0 to UBound(sarrVersionList) If sarrVersionList(i) > sintLocalVersion Then Rem ## 若有最新版本, 則退出循環 IsLastVersion = False Info = "已經是最新版本!" Exit For End If Next Else Rem ## 否則返回出錯信息 IsLastVersion = True Info = "獲取版本信息時出錯!(#2)" End If End function Rem ################################################################# Rem ## 檢測是否為最新版本 Rem ################################################################# Private function iniVersionList() iniVersionList = False
Dim strVersion strVersion = getVersionList()
Rem ## 若返回值為空, 則初始化失敗 If strVersion = "" Then Info = "出錯......." Exit function End If
iniVersionList = True End function Rem ################################################################# Rem ## 檢測是否為最新版本 Rem ################################################################# Private function getVersionList() getVersionList = GetContent(UrlVersion) End function Rem ################################################################# Rem ## 開始更新 Rem ################################################################# Private function NowUpdate() Dim i For i = UBound(sarrVersionList) to 0 step -1 Call doUpdateVersion(sarrVersionList(i)) Next Info = "升級完成! <a href=""" & sstrUrlLocal & UrlHistory & """>查看</a>" End function Rem #################################################################
Rem ## 更新版本內容 Rem ################################################################# Private function doUpdateVersion(strVer) doUpdateVersion = False
Dim intVer intVer = toNum(Replace(strVer, ".", ""<IMG SRC="smile/05.gif">, 0)
Rem ## 若將更新的版本小于當前版本, 則退出更新 If intVer <= sintLocalVersion Then Exit function End If
Rem ## 更新文件 Rem ################################################################# Private function doUpdateFile(strSourceFile, strTargetFile) Dim strContent strContent = GetContent(sstrUrlUpdate & strSourceFile)
Rem ## 更新并寫入日志 If sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile), strContent) Then sstrLogContent = sstrLogContent & " 成功" & vbCrLf Else sstrLogContent = sstrLogContent & " 失敗" & vbCrLf End If End function Rem ################################################################# Rem ## 遠程獲得內容 Rem ################################################################# Private function GetContent(strUrl) GetContent = ""
Dim oXhttp, strContent Set oXhttp = Server.CreateObject("Microsoft.xmlHTTP"<IMG SRC="smile/05.gif"> 'On Error Resume Next With oXhttp .Open "GET", strUrl, False, "", "" .Send If .readystate <> 4 Then Exit function strContent = .Responsebody
strContent = sBytesToBstr(strContent) End With
Set oXhttp = Nothing If Err.Number <> 0 Then response.Write(Err.Description) Err.Clear Exit function End If
GetContent = strContent End function Rem ################################################################# Rem ################################################################# Rem ## 編碼轉換 2進制 => 字符串 Private function sBytesToBstr(vIn) dim objStream set objStream = Server.CreateObject("adodb.stream"<IMG SRC="smile/05.gif"> objStream.Type = 1 objStream.Mode = 3 objStream.Open objStream.Write vIn
objStream.Position = 0 objStream.Type = 2 objStream.Charset = "GB2312" sBytesToBstr = objStream.ReadText objStream.Close set objStream = nothing End function Rem ################################################################# Rem ################################################################# Rem ## 編碼轉換 2進制 => 字符串 Private function sDoCreateFile(strFileName, ByRef strContent) sDoCreateFile = False Dim strPath strPath = Left(strFileName, InstrRev(strFileName, "/", -1, 1)) Rem ## 檢測路徑及文件名有效性 If Not(CreateDir(strPath)) Then Exit function 'If Not(CheckFileName(strFileName)) Then Exit function
'response.Write(strFileName) Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif"> Set f = fso.OpenTextFile(strFileName, ForWriting, True) f.Write strContent f.Close Set fso = nothing Set f = nothing sDoCreateFile = True End function Rem ################################################################# Rem ################################################################# Rem ## 編碼轉換 2進制 => 字符串 Private function sDoAppendFile(strFileName, ByRef strContent) sDoAppendFile = False Dim strPath strPath = Left(strFileName, InstrRev(strFileName, "/", -1, 1)) Rem ## 檢測路徑及文件名有效性 If Not(CreateDir(strPath)) Then Exit function 'If Not(CheckFileName(strFileName)) Then Exit function
'response.Write(strFileName) Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject"<IMG SRC="smile/05.gif"> Set f = fso.OpenTextFile(strFileName, ForAppending, True) f.Write strContent f.Close Set fso = nothing Set f = nothing sDoAppendFile = True End function Rem ################################################################# Rem ## 建立目錄的程序，如果有多級目錄，則一級一級的創建 Rem ################################################################# Private function CreateDir(ByVal strLocalPath) Dim i, strPath, objFolder, tmpPath, tmptPath Dim arrPathList, intLevel
For I = 0 To intLevel If I = 0 Then tmptPath = arrPathList(0) & "/" Else tmptPath = tmptPath & arrPathList(I) & "/" End If tmpPath = Left(tmptPath, Len(tmptPath) - 1) If Not objFolder.FolderExists(tmpPath) Then objFolder.CreateFolder tmpPath Next
Set objFolder = Nothing If Err.Number <> 0 Then CreateDir = False Err.Clear Else CreateDir = True End If End function Rem ################################################################# Rem ## 長整數轉換 Rem ################################################################# Private function toNum(s, default) If IsNumeric(s) and s <> "" then toNum = CLng(s) Else toNum = default End If End function Rem ################################################################# End Class Rem ##################################################################################### %>
