●●代码发布●ASP软件在线升级通用类

xiaoyuehen 2004-12-11 03:11:03
●描述: ASP 在线升级类
●版本: 1.0.0
●作者: 萧月痕(xiaoyuehen)
●MSN: xiaoyuehen(at)msn.com
●请将(at)以 @ 替换
●版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!
●如果您能保留这些说明信息, 本人更加感谢!
●如果您有更好的代码优化, 相关改进, 请记得告诉我, 非常感谢!
●在开始之前, 请细读如下说明.

●服务器端要求:
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 升级

相关参数都设定好了之后, 即可以此方法开始长级

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

●请先别回复, 文件在下面
...全文
167 13 打赏 收藏 转发到动态 举报
写回复
用AI写文章
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
xiaoyuehen 2004-12-12
  • 打赏
  • 举报
 回复
顶~~~~~~~~~~~~~~~
可以在下面看到更好的代码格式
http://blog.csdn.net/xiaoyuehen/archive/2004/12/11/213094.aspx
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
上面说错了一点
创建目录 函数很好用 是在这个页面找到的, 不好意思.-__-|||
Jaron(唐伯虎点蚊香，不烧香) http://blog.csdn.net/jaron/archive/2003/11/12/15134.aspx
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
嗯, 忘了说.

回复人： iuhxq(小灰) ( ) 信誉：100 的代码给我很大启发. 那个 创建目录 函数很好用...呵呵...我稍微改了一下(就变量名:D)
还有这个 If .readystate <> 4 一直在找的.

to 回复人： babyt(阿泰) ( ) 信誉：100

四个月就弄了个星还不够快啊~~~~~~~--__--|||

我好像是 2002 年 注册的.
iuhxq 2004-12-11
  • 打赏
  • 举报
 回复
呵呵

http://blog.csdn.net/iuhxq/archive/2004/12/11/212987.aspx
http://blog.csdn.net/iuhxq/archive/2004/09/29/120254.aspx
阿泰 2004-12-11
  • 打赏
  • 举报
 回复
我这个红星星用了四个月的时间(我2001年注册的,呵呵,一直怎么发言),够漫长吧

^_^

dachangtui 2004-12-11
  • 打赏
  • 举报
 回复
thanks
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
谢谢babyt(阿泰) ....还是你快啊...已经升星了哦!恭喜恭喜!~~~~~~~~~
阿泰 2004-12-11
  • 打赏
  • 举报
 回复
xiaoyuehen 的作品和思路都很精彩,支持 :)
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
●思路:
1. 查询版本列表 => 2. 比较版本差异 => 3. 获取高一版本更新列表, 若没有更高版本则跳到步骤 5 => 4. 更新 => 返回 步骤 3

5. 退出更新

●题外话: 总共花了大概 7 个小时, 有点匆促, 代码还不够精细. 在本地测试时, 更新两个版本, 共 4 个文件, 花了将近 1 秒的时间.

以前也没有做过类似的东西, 所以谈不上什么算法, 有做过的朋友请多多提意见, 谢谢!

●本代码旨在互相交流●
zlj113 2004-12-11
  • 打赏
  • 举报
 回复
收藏，UP，学习！！！
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
●其他说明: 版本号必须为0-9的数字和.组成, 且第一位不能小于1, 各版本号长度必须一致.如1.0.0和1.2.2 或者 1.2.04和1.2.78

●其他说明: 增量升级.

上面的代码看起来较乱, 请复制粘贴到 DW 或 EditPlus中再看.
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
接上:

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 #####################################################################################
%>
xiaoyuehen 2004-12-11
  • 打赏
  • 举报
 回复
●类文件 Cls_OnlineUpdate.asp

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

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 #################################################################
完美学校网站系统全站源代码学校网站模板下载
26：最新添加单位稿件统计（旧版本升级请后台运行Tools_UpdateDB-11-6.asp升级数据库） 27：其他错误修正 29：首页田字格小图片数量选择 29：后台1~3级菜单选择 30：系统设置不启用分级时打开新闻页空白补丁 31...
一个牛人提供的GIS源码(很好)
特色二：系统采用了实时在线更新的方法对软件进行升级，升级仅仅需要设置好服务端以及更新文件列表等即可。 特色三：界面上有所创新，吸取Google的WEB地图的界面，对部分控制条进行显示和隐藏。可以看我以前的截图，...
基于J2EE框架的个人博客系统项目毕业设计论文(源码和论文）
由于客户端的硬件配置可能存在差异，软件环能各不相同，因此，在安装时，必须对每一个客户端分别进行配置，同样，在软件升级时也要对客户端分别处理。 B/S模式带来了巨大的好处： 开发成本及维护成本降低。由于B/S...
Asp.net常用的51个代码（值得收藏）
1.弹出对话框.... Code: Response.Write("<script>window.alert('该会员没有...window.location ='http://www.msproject.cn/index.asp'</script>"); 2.弹出对话框 Code: Response.Write("<script lan
基于ASP.NET的在线考试系统
ASP.Net的最大特点就是在软件系统开发过程中可以实现对多种软件系统设计语言的支持，无论采用C语言还是C++语言、C#语言、Java语言对软件系统进行开发，在软件系统的运行和编译过程中都被同样的编译成一种通用的中间...
ASP

28,391

社区成员

357,059

社区内容

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages，是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章