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
●例:

程序代码

<%
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 #####################################################################################
%>