ASP在线升级类

核心提示：<%Rem #Rem ## 在线升级类声明Class Cls_oUpdate Rem # Rem ## 描述: asp 在线升级类 Rem ## 版本: 1.0.0 Rem ## 作者: 萧月痕 Rem ## MSN: xiaoyuehen(at)msn.com Rem ## 请将(at)以 @ 替

<%
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 ## 升级URL, 以 http:// 起头, /结尾
　 Rem ## 例: http://localhost/software/
　 UrlUpdate　　 = ""
　
　 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
　
　 UrlVersion　  = Trim(UrlVersion)
　 UrlUpdate　  = Trim(UrlUpdate)
　
　 Rem ## 升级网址检测
　 If (Left(UrlVersion, 7) <> "http://"<IMG SRC="http://www.cncms.com/smile/05.gif"> Or (Left(UrlUpdate, 7) <> "http://"<IMG SRC="http://www.cncms.com/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 ## 当前版本信息(数字)
　 sstrLocalVersion = LocalVersion
　 sintLocalVersion = Replace(sstrLocalVersion, ".", ""<IMG SRC="http://www.cncms.com/smile/05.gif">
　 sintLocalVersion = toNum(sintLocalVersion, 0)
　
　 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
　 
　  sstrVersionList = Replace(strVersion, " ", ""<IMG SRC="http://www.cncms.com/smile/05.gif">
　  sarrVersionList = Split(sstrVersionList, vbCrLf)
　 
　  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="http://www.cncms.com/smile/05.gif">, 0)
　 
　  Rem ## 若将更新的版本小于当前版本, 则退出更新
　  If intVer <= sintLocalVersion Then
　　 Exit function
　  End If
　 
　  Dim strFileListContent, arrFileList, strUrlUpdate　
　  strUrlUpdate = sstrUrlUpdate & intVer & FileType
　 
　  strFileListContent = GetContent(strUrlUpdate)
　 
　  If strFileListContent = "" Then
　　 Exit function
　  End If
　 
　  Rem ## 更新当前版本号
　  sintLocalVersion = intVer
　  sstrLocalVersion = strVer
　 
　  Dim i, arrTmp
　  Rem ## 获取更新文件列表
　  arrFileList = Split(strFileListContent, vbCrLf)
　 
　  Rem ## 更新日志
　  sstrLogContent = ""
　  sstrLogContent = sstrLogContent & strVer & ":" & vbCrLf
　 
　  Rem ## 开始更新
　  For i = 0 to UBound(arrFileList)
　　 Rem ## 更新格式: 版本号/文件.htm|目的文件
　　 arrTmp = Split(arrFileList(i), "|"<IMG SRC="http://www.cncms.com/smile/05.gif">
　　 sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
　　 Call doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))　　
　  Next
　 
　  Rem ## 写入日志文件
　  sstrLogContent = sstrLogContent & Now() & vbCrLf
　  response.Write("<pre>" & sstrLogContent & "</pre>"<IMG SRC="http://www.cncms.com/smile/05.gif">
　  Call sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"<IMG SRC="http://www.cncms.com/smile/05.gif">, _　　　　　　　　　　　　　　　　　　　　  "<pre>" & sstrLogContent & "</pre>"<IMG SRC="http://www.cncms.com/smile/05.gif">
　  Call sDoAppendFile(Server.MapPath(sstrUrlLocal & UrlHistory), "<pre>" & _　　　　　　　　　　　　　　　　　　　　  strVer & "_______" & Now() & "</pre>" & vbCrLf)
　 End function
  Rem #################################################################
 
  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="http://www.cncms.com/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="http://www.cncms.com/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="http://www.cncms.com/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="http://www.cncms.com/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
　 
　  'On Error Resume Next
　  strPath　　 = Replace(strLocalPath, "\", "/"<IMG SRC="http://www.cncms.com/smile/05.gif">
　  Set objFolder  = server.CreateObject("Scripting.FileSystemObject"<IMG SRC="http://www.cncms.com/smile/05.gif">
　  arrPathList　 = Split(strPath, "/"<IMG SRC="http://www.cncms.com/smile/05.gif">
　  intLevel　　 = UBound(arrPathList)
　 
　  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 #####################################################################################
%>