WEB开发网
开发学院WEB开发ASP ASP在线升级类 阅读

ASP在线升级类

 2009-06-30 04:59:00 来源:WEB开发网   
核心提示:<%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 #####################################################################################
%>

Tags:ASP 在线升级

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接