asp在线升级类文件

< %
ClassCls_oUpdate
Public LocalVersion,LastVersion,FileType
Public UrlVersion,UrlUpdate,UpdateLocalPath,Info
Public UrlHistory Private sstrVersionList,sarrVersionList,sintLocalVersion,sstrLocalVersion Private sstrLogContent,sstrHistoryContent,sstrUrlUpdate,sstrUrlLocal
Private Sub Class_Initialize()
Private Sub Class_Terminate()
EndSub

Public function doUpdate()
doUpdate = False
UrlVersion = Trim (UrlVersion)
UrlUpdate = Trim (UrlUpdate)
' 升级网址检测
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
' 当前版本信息(数字)
sstrLocalVersion = LocalVersion
sintLocalVersion = Replace (sstrLocalVersion, " . " , "" )
sintLocalVersion = toNum(sintLocalVersion, 0 )
' 版本检测(初始化版本信息,并进行比较)
If IsLastVersion Then
Exit function
' 开始升级
doUpdate = NowUpdate()
LastVersion = sstrLocalVersion
Endfunction



' ****************************
' 检测是否为最新版本
' *****************************
Private function IsLastVersion()
' 初始化版本信息(初始化sarrVersionList数组)
If iniVersionList Then
' 若成功,则比较版本
Dim i
IsLastVersion = True
For i = 0 to UBound (sarrVersionList)
If sarrVersionList(i) > sintLocalVersion Then
' 若有最新版本,则退出循环
IsLastVersion = False
Info = " 已经是最新版本! "
Exit For
End If
Next
Else
' 否则返回出错信息
IsLastVersion = True
Info = " 获取版本信息时出错!(#2) "
End If
Endfunction



' **************************
' 检测是否为最新版本
' ***************************
Private function iniVersionList()
iniVersionList = False
Dim strVersion
strVersion = getVersionList()
' 若返回值为空,则初始化失败
If strVersion = "" Then
Info = " 出错....... "
Exit function
End If
sstrVersionList = Replace (strVersion, " " , "" )
sarrVersionList = Split (sstrVersionList,vbCrLf)
iniVersionList = True
Endfunction



' ************************
' 检测是否为最新版本
' ************************
Private function getVersionList()
getVersionList = GetContent(UrlVersion)
Endfunction


' *********************
' 开始更新
' *********************
Private function NowUpdate()
Dim i
For i = UBound (sarrVersionList) to 0 step - 1
Call doUpdateVersion(sarrVersionList(i))
Next
Info = " 升级完成!<ahref="" " & sstrUrlLocal & UrlHistory & " "">查看</a> "
Endfunction



' ******************
' 更新版本内容
' ******************
Private function doUpdateVersion(strVer)
doUpdateVersion = False
Dim intVer
intVer = toNum( Replace (strVer, " . " , "" ), 0 )
' 若将更新的版本小于当前版本,则退出更新
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
' 更新当前版本号
sintLocalVersion = intVer
sstrLocalVersion = strVer
Dim i,arrTmp
' 获取更新文件列表
arrFileList = Split (strFileListContent,vbCrLf)
' 更新日志
sstrLogContent = ""
sstrLogContent = sstrLogContent & strVer & " : " & vbCrLf
' 开始更新
For i = 0 to UBound (arrFileList)
' 更新格式:版本号/文件.htm|目的文件
arrTmp = Split (arrFileList(i), " | " )
sstrLogContent = sstrLogContent & vbTab & arrTmp( 1 )
Call doUpdateFile(intVer & " / " & arrTmp( 0 ),arrTmp( 1 ))
Next
' 写入日志文件
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)
Endfunction


' ********************
' 更新文件
' ********************
Private function doUpdateFile(strSourceFile,strTargetFile)
Dim strContentstrContent = GetContent(sstrUrlUpdate & strSourceFile)
' 更新并写入日志
If sDoCreateFile(Server.MapPath(sstrUrlLocal & strTargetFile),strContent) Then sstrLogContent = sstrLogContent & " 成功 " & vbCrLf
Else
sstrLogContent = sstrLogContent & " 失败 " & vbCrLf
End If
Endfunction



' ********************
' 远程获得内容
' ********************

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
Endfunction




' *************************
' 编码转换2进制=>字符串
' *************************

Private function sBytesToBstr(vIn)
dim objStream
set objStream = Server.CreateObject( " adodb.stream " )
objStream.Type = 1
objStream.Mode = 3
objStream.Open
objStream.WritevIn
objStream.Position = 0
objStream.Type = 2
objStream.Charset = " GB2312 "
sBytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
Endfunction


' ******************************
' 编码转换2进制=>字符串
' ******************************

Private function sDoCreateFile(strFileName,ByRefstrContent)
sDoCreateFile = False
Dim strPath
strPath = Left (strFileName, InstrRev (strFileName, " " , - 1 , 1 ))
' 检测路径及文件名有效性
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.WritestrContent
f.Close
Set fso = nothing
Set f = nothing
sDoCreateFile = True
Endfunction




' **************************
' 编码转换2进制=>字符串
' **************************

Private function sDoAppendFile(strFileName,ByRefstrContent)
sDoAppendFile = False
Dim strPath
strPath = Left (strFileName, InstrRev (strFileName, " " , - 1 , 1 ))
' 检测路径及文件名有效性
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.WritestrContent
f.Close
Set fso = nothing
Set f = nothing
sDoAppendFile = True
Endfunction



' ************************************************
' 建立目录的程序，如果有多级目录，则一级一级的创建
' ************************************************

Private function CreateDir(ByValstrLocalPath)
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.CreateFoldertmpPath
Next
Set objFolder = Nothing
If Err.Number <> 0 Then
CreateDir = False
Err.Clear
Else
CreateDir = True
End If
Endfunction

' ***********************
' 长整数转换
' ***********************

Private function toNum(s,default)
If IsNumeric (s) and s <> "" then
toNum = CLng (s)
Else
toNum = default
End If
Endfunction
End Class
% >

================================================================================================

●描述: ASP 在线升级类

●版本: 1.0.0

●版权: 既然共享, 就无所谓版权了. 但必须限于网络传播, 不得用于传统媒体!

●如果您能保留这些说明信息, 本人更加感谢!

●如果您有更好的代码优化, 相关改进, 请记得告诉我, 非常感谢!

●思路:1. 查询版本列表 => 2. 比较版本差异 => 3. 获取高一版本更新列表, 若没有更高版本则跳到步骤 5 => 4. 更新 => 返回 步骤 35. 退出更新

●其他说明: 增量升级.

●题外话: 总共花了大概 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%>