asp在线升级类文件

最新推荐文章于 2025-01-22 10:17:39 发布

iteye_6481

最新推荐文章于 2025-01-22 10:17:39 发布

阅读量101

点赞数

ClassCls_oUpdate

PublicLocalVersion,LastVersion,FileType

PublicUrlVersion,UrlUpdate,UpdateLocalPath,Info

PublicUrlHistoryPrivatesstrVersionList,sarrVersionList,sintLocalVersion,sstrLocalVersionPrivatesstrLogContent,sstrHistoryContent,sstrUrlUpdate,sstrUrlLocal

PrivateSubClass_Initialize()

PrivateSubClass_Terminate()

EndSub

PublicfunctiondoUpdate()

doUpdate=False

UrlVersion=Trim(UrlVersion)

UrlUpdate=Trim(UrlUpdate)

'升级网址检测

If(Left(UrlVersion,7)<>"http://")Or(Left(UrlUpdate,7)<>"http://")Then

Info="版本检测网址为空,升级网址为空或格式错误(#1)"

Exitfunction

EndIf

IfRight(UrlUpdate,1)<>"/"Then

sstrUrlUpdate=UrlUpdate&"/"

Else

sstrUrlUpdate=UrlUpdate

EndIf

IfRight(UpdateLocalPath,1)<>"/"Then

sstrUrlLocal=UpdateLocalPath&"/"

Else

sstrUrlLocal=UpdateLocalPath

EndIf

'当前版本信息(数字)

sstrLocalVersion=LocalVersion

sintLocalVersion=Replace(sstrLocalVersion,".","")

sintLocalVersion=toNum(sintLocalVersion,0)

'版本检测(初始化版本信息,并进行比较)

IfIsLastVersionThen

Exitfunction

'开始升级

doUpdate=NowUpdate()

LastVersion=sstrLocalVersion

Endfunction

'****************************

'检测是否为最新版本

'*****************************

PrivatefunctionIsLastVersion()

'初始化版本信息(初始化sarrVersionList数组)

IfiniVersionListThen

'若成功,则比较版本

Dimi

IsLastVersion=True

Fori=0toUBound(sarrVersionList)

IfsarrVersionList(i)>sintLocalVersionThen

'若有最新版本,则退出循环

IsLastVersion=False

Info="已经是最新版本!"

ExitFor

EndIf

Else

'否则返回出错信息

IsLastVersion=True

Info="获取版本信息时出错!(#2)"

EndIf

Endfunction

'**************************

'检测是否为最新版本

'***************************

PrivatefunctioniniVersionList()

iniVersionList=False

DimstrVersion

strVersion=getVersionList()

'若返回值为空,则初始化失败

IfstrVersion=""Then

Info="出错......."

Exitfunction

EndIf

sstrVersionList=Replace(strVersion,"","")

sarrVersionList=Split(sstrVersionList,vbCrLf)

iniVersionList=True

Endfunction

'************************

'检测是否为最新版本

'************************

PrivatefunctiongetVersionList()

getVersionList=GetContent(UrlVersion)

Endfunction

'*********************

'开始更新

'*********************

PrivatefunctionNowUpdate()

Dimi

Fori=UBound(sarrVersionList)to0step-1

CalldoUpdateVersion(sarrVersionList(i))

Info="升级完成!<ahref="""&sstrUrlLocal&UrlHistory&""">查看</a>"

Endfunction

'******************

'更新版本内容

'******************

PrivatefunctiondoUpdateVersion(strVer)

doUpdateVersion=False

DimintVer

intVer=toNum(Replace(strVer,".",""),0)

'若将更新的版本小于当前版本,则退出更新

IfintVer<=sintLocalVersionThen

Exitfunction

EndIf

DimstrFileListContent,arrFileList,strUrlUpdate

strUrlUpdate=sstrUrlUpdate&intVer&FileType

strFileListContent=GetContent(strUrlUpdate)

IfstrFileListContent=""Then

Exitfunction

EndIf

'更新当前版本号

sintLocalVersion=intVer

sstrLocalVersion=strVer

Dimi,arrTmp

'获取更新文件列表

arrFileList=Split(strFileListContent,vbCrLf)

'更新日志

sstrLogContent=""

sstrLogContent=sstrLogContent&strVer&":"&vbCrLf

'开始更新

Fori=0toUBound(arrFileList)

'更新格式:版本号/文件.htm|目的文件

arrTmp=Split(arrFileList(i),"|")

sstrLogContent=sstrLogContent&vbTab&arrTmp(1)

CalldoUpdateFile(intVer&"/"&arrTmp(0),arrTmp(1))

'写入日志文件

sstrLogContent=sstrLogContent&Now()&vbCrLf

response.Write("<pre>"&sstrLogContent&"</pre>")

CallsDoCreateFile(Server.MapPath(sstrUrlLocal&"Log"&intVer&".htm"),_

"<pre>"&sstrLogContent&"</pre>")

CallsDoAppendFile(Server.MapPath(sstrUrlLocal&UrlHistory),"<pre>"&_

strVer&"_______"&Now()&"</pre>"&vbCrLf)

Endfunction

'********************

'更新文件

'********************

PrivatefunctiondoUpdateFile(strSourceFile,strTargetFile)

DimstrContentstrContent=GetContent(sstrUrlUpdate&strSourceFile)

'更新并写入日志

IfsDoCreateFile(Server.MapPath(sstrUrlLocal&strTargetFile),strContent)ThensstrLogContent=sstrLogContent&"成功"&vbCrLf

Else

sstrLogContent=sstrLogContent&"失败"&vbCrLf

EndIf

Endfunction

'********************

'远程获得内容

'********************

PrivatefunctionGetContent(strUrl)

GetContent=""

DimoXhttp,strContent

SetoXhttp=Server.CreateObject("Microsoft.XMLHTTP")

OnErrorResumeNext

WithoXhttp.Open"GET",strUrl,False,"","".Send

If.readystate<>4ThenExitfunction

strContent=.Responsebody

strContent=sBytesToBstr(strContent)

EndWith

SetoXhttp=Nothing

IfErr.Number<>0Then

response.Write(Err.Description)

Err.Clear

Exitfunction

EndIf

GetContent=strContent

Endfunction

'*************************

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

'*************************

PrivatefunctionsBytesToBstr(vIn)

dimobjStream

setobjStream=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

setobjStream=nothing

Endfunction

'******************************

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

'******************************

PrivatefunctionsDoCreateFile(strFileName,ByRefstrContent)

sDoCreateFile=False

DimstrPath

strPath=Left(strFileName,InstrRev(strFileName,"",-1,1))

'检测路径及文件名有效性

IfNot(CreateDir(strPath))

ThenExitfunction

IfNot(CheckFileName(strFileName))Then

Exitfunction

response.Write(strFileName)

ConstForReading=1,ForWriting=2,ForAppending=8

Dimfso,fSetfso=CreateObject("Scripting.FileSystemObject")

Setf=fso.OpenTextFile(strFileName,ForWriting,True)

f.WritestrContent

f.Close

Setfso=nothing

Setf=nothing

sDoCreateFile=True

Endfunction

'**************************

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

'**************************

PrivatefunctionsDoAppendFile(strFileName,ByRefstrContent)

sDoAppendFile=False

DimstrPath

strPath=Left(strFileName,InstrRev(strFileName,"",-1,1))

'检测路径及文件名有效性

IfNot(CreateDir(strPath))Then

Exitfunction

IfNot(CheckFileName(strFileName))Then

Exitfunction

response.Write(strFileName)

ConstForReading=1,ForWriting=2,ForAppending=8

Dimfso,f

Setfso=CreateObject("Scripting.FileSystemObject")

Setf=fso.OpenTextFile(strFileName,ForAppending,True)

f.WritestrContent

f.Close

Setfso=nothing

Setf=nothing

sDoAppendFile=True

Endfunction

'************************************************

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

'************************************************

PrivatefunctionCreateDir(ByValstrLocalPath)

Dimi,strPath,objFolder,tmpPath,tmptPath

DimarrPathList,intLevel

OnErrorResumeNext

strPath=Replace(strLocalPath,"","/")

SetobjFolder=server.CreateObject("Scripting.FileSystemObject")

arrPathList=Split(strPath,"/")

intLevel=UBound(arrPathList)

ForI=0TointLevelIfI=0Then

tmptPath=arrPathList(0)&"/"

Else

tmptPath=tmptPath&arrPathList(I)&"/"

EndIf

tmpPath=Left(tmptPath,Len(tmptPath)-1)

IfNotobjFolder.FolderExists(tmpPath)Then

objFolder.CreateFoldertmpPath

SetobjFolder=Nothing

IfErr.Number<>0Then

CreateDir=False

Err.Clear

Else

CreateDir=True

EndIf

Endfunction

'***********************

'长整数转换

'***********************

PrivatefunctiontoNum(s,default)

IfIsNumeric(s)ands<>""then

toNum=CLng(s)

Else

toNum=default

EndIf

Endfunction

EndClass

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

●描述: 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 升级相关参数都设定好了之后, 即可以此方法开始长级