IDC资讯中心
<%
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 #################################################################
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 #####################################################################################
%>
