WEB开发网
开发学院WEB开发ASP ASP在线升级类及说明文件 阅读

ASP在线升级类及说明文件

 2009-06-30 04:25:00 来源:WEB开发网   
核心提示:●描述: asp 在线升级类●版本: 1.0.0●作者: 萧月痕(xiaoyuehen)●MSN: xiaoyuehen(at)msn.com●请将(at)以 @ 替换●版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!●如果您能保留这些说明信息, 本人更加感谢!●如果您有更好的代码优化,

●描述: asp 在线升级类
●版本: 1.0.0
●作者: 萧月痕(xiaoyuehen)
●MSN:  xiaoyuehen(at)msn.com
●请将(at)以 @ 替换
●版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!
●如果您能保留这些说明信息, 本人更加感谢!
●如果您有更好的代码优化, 相关改进, 请记得告诉我, 非常感谢!
●思路:
1. 查询版本列表 => 2. 比较版本差异 => 3. 获取高一版本更新列表, 若没有更高版本则跳到步骤 5 => 4. 更新 => 返回 步骤 3
5. 退出更新
●其他说明: 增量升级.
●题外话: 总共花了大概 7 个小时, 有点匆促, 代码还不够精细. 在本地测试时, 更新两个版本, 共 4 个文件, 花了将近 1 秒的时间.
以前也没有做过类似的东西, 所以谈不上什么算法, 有做过的朋友请多多提意见, 谢谢!
●本代码旨在互相交流●
●在开始之前, 请细读如下说明.
●服务器端要求:
  1. 站点管理器, 能通过URL地址访问到版本及相关升级信息即可.
  2. 版本信息文件, 如Version.asp
  3. 各版本目录 必须在 UrlUpdate(描述见下面) 指定的目录之下, 例: UrlUpdate 为 http://Localhost/__Jxc/Update/,
   Version 为 1.0.8 则 此版本的升级文件必须位于 http://Localhost/__Jxc/Update/108/ 下.
  4. 版本信息返回的信息为一列表, 每行代表一个版本信息(不能有空行), 高版本在上.如下格式:
     1.1.0
     1.0.8
     1.0.0
  5. 某一版本的文件更新信息格式为去除.号后的数字 + FileType(描述见下), 放在 UrlUpdate 下   如: http://Localhost/__Jxc/Update/110.asp, 其内容格式如下:
     3.htm|Test/Test/3.asp
     4.htm|Test/Test/4.asp
     5.htm|Test/5.asp
     6.htm|Test/6.asp
以|分隔源文件和目的文件. 源文件将从对应的版本目录读取, 如上 3.htm 对应的地址应为
http://Localhost/__Jxc/Update/110/3.htm
若 UpdateLocalPath = "/" 则 Test/Test/3.asp 对应的更新目的为 /Test/Test/3.asp, 在更新过程中程序会自动创建不存在的目录,
并覆盖目标文件

●客户端要求:
  IIS 5.0 以上
  fso 支持(用于生成文件)
  Adodb.Stream 支持(用于编码转换)
  Microsoft.xmlHTTP 支持(用于远程获取信息)
●属性:
  Info 获得升级过程中最后信息
●参数描述:
  UrlVersion ●必须● 版本信息完整URL, 以 http:// 起头
  UrlUpdate  ●必须● 升级URL, 以 http:// 起头, /结尾
  UpdateLocalPath ●必须● 本地更新目录, 以 / 起头, /结尾. 以 / 起头是为当前站点更新.防止写到其他目录. ●默认值● /
  UrlHistory ●必须● 生成的软件历史文件文件名
  LocalVersion ●必须● 当前版本信息 ●默认值● 1.0.0
  FileType ●必须● 版本信息后缀名 ●默认值● .asp
●方法描述:
  doUpdate 升级
 
  相关参数都设定好了之后, 即可以此方法开始长级
●其他说明: 版本号必须为0-9的数字和.组成, 且第一位不能小于1, 各版本号长度必须一致.如1.0.0和1.2.2 或者 1.2.04和1.2.78
●例:

 程序代码
<!--#include file="../__Inc/Cls_OnlineUpdate.asp"-->
<%
Dim objUpdate
Set objUpdate = New Cls_oUpdate
With objUpdate
  .UrlVersion = "http://Localhost/__Jxc/Update/Version.asp"
  .UrlUpdate = "http://Localhost/__Jxc/Update/"
  .UpdateLocalPath = "/"
 
  .LocalVersion = "1.0.0"
  .doUpdate
  response.Write(.Info)
End With
 
Set objUpdate = Nothing
%>


类文件:


 程序代码
<%
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://") or (Left(UrlUpdate, 7) <> "http://") 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, ".", "")
  sintLocalVersion = toNum(sintLocalVersion, 0)
 
  Rem ## 版本检测(初始化版本信息, 并进行比较)
  If IsLastVersion Then Exit function
 
  Rem ## 开始升级
  doUpdate = NowUpdate()
  LastVersion = sstrLocalVersion
  End function
  Rem #################################################################
  http://bizhi.cncms.com/
  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, " ", "")
   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 #################################################################
  http://QQface.cncms.com/
  Rem ## 更新版本内容
  Rem #################################################################
  Private function doUpdateVersion(strVer)
   doUpdateVersion = False
  
   Dim intVer
   intVer = toNum(Replace(strVer, ".", ""), 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), "|")
   sstrLogContent = sstrLogContent & vbTab & arrTmp(1)
   Call doUpdateFile(intVer & "/" & arrTmp(0), arrTmp(1))  
   Next
  
   Rem ## 写入日志文件
   sstrLogContent = sstrLogContent & Now() & vbCrLf
   response.Write("<pre>" & sstrLogContent & "</pre>")
   Call sDoCreateFile(Server.MapPath(sstrUrlLocal & "Log" & intVer & ".htm"), _
   "<pre>" & sstrLogContent & "</pre>")
   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")
   '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")
   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")
   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")
   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, "\", "/")
   Set objFolder  = server.CreateObject("Scripting.FileSystemObject")
   arrPathList  = Split(strPath, "/")
   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 在线升级 说明

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