ASP升级程序

　　来源: 小灰的专栏

　　<%
文件名：updata.asp
远程地址
const url=

　　action=request(action)
if action=updata then
download(urlconfig.txt)
download(urlpack.jpg)
response.Write(下载成功<a href=updata.asp?action=install>安装</a>)
elseif action=install then
str=openfile(config.txt)
if str= then
response.write 缺少本地配置文件config.txt
else
size=RegExpTest(size,str)
call install(pack.jpg,size)
end if
else
str=getpage(urlconfig.txt)
if str= then
response.write 不存在可用更新或者本地配置不正确
response.end
end if

　　str1=openfile(config.txt)
if str1= then
response.write 缺少本地配置文件config.txt无法获知本地程序的安装时间
response.end
end if

　　updatatime=RegExpTest(time,str)
updatatime1=RegExpTest(time,str1)

　　if DateDiff(d,updatatime1,updatatime)>0 then
response.Write(存在可用更新，更新日期：updatatime<a href=updata.asp?action=updata>下载</a>)
else
response.write 您的程序是最新的了
end if
end if

　　function openfile(filename)
set fso=server.CreateObject(scripting.filesystemobject)
if fso.fileexists(server.MapPath(filename)) then
set f1=fso.opentextfile(server.mappath(filename),1,true)
openfile=f1.readall
f1.close
else
openfile=
end if
set fso=nothing
end function

　　function getpage(url)
set xmlhttp=server.createobject(Microsoft.XMLHTTP)
xmlhttp.open get,url,false
xmlhttp.send
if xmlhttp.status<>200 then
getpage=
else
getpage=bytes2BSTR(xmlhttp.ResponseBody)
end if
end function

　　Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn =
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < H80 Then
strReturn = strReturn Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn Chr(CLng(ThisCharCode) * H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

　　Function RegExpTest(patrn,strng)
Dim regEx,Match,Matches建立变量。
Set regEx = New RegExp建立正则表达式。
regEx.Pattern = patrn=(.+?) 设置模式。
regEx.IgnoreCase = True设置是否区分字符大小写。
regEx.Global = True设置全局可用性。
Set Matches = regEx.Execute(strng)执行搜索。
For Each Match in Matches遍历匹配集合。
RetStr = Match.Value
Next
RegExpTest = replace(RetStr,patrn=,)
End Function

　　function download(url)
temp=split(url,/)
filename=temp(ubound(temp))
set xmlhttp=server.createobject(Microsoft.XMLHTTP)
xmlhttp.open get,url,false
xmlhttp.send
if xmlhttp.status<>200 then
download=
else
set fso=server.createobject(scripting.filesystemobject)
if fso.fileexists(server.mappath(filename)) then
fso.deletefile(server.mappath(filename))
end if
set fso=nothing
img=xmlhttp.ResponseBody
set objAdostream=server.createobject(ADODB.Stream)
objAdostream.Open
objAdostream.type=1
objAdostream.Write(img)
objAdostream.SaveToFile(server.mappath(filename))
objAdostream.SetEOS
set objAdostream=nothing
download=filename
end if
set xmlhttp=nothing
end function

　　
function install(filename,size)
on error resume next
path=server.mappath(./)

　　set fso=server.createobject(scripting.filesystemobject)

　　set s=server.createobject(adodb.stream)
set s1=server.createobject(adodb.stream)
set s2=server.createobject(adodb.stream)

　　s.open
s1.open
s2.open

　　s.type=1
s1.type=1
s2.type=1

　　s.loadfromfile(server.mappath(filename))
s.position=size
s1.write(s.read)
s1.position=0
s1.type=2
s1.charset=gb2312
s1.position=0
a=split(s1.readtext,vbcrlf)
s.position=0

　　i=0
while(i<ubound(a))
b=split(a(i),>)
if b(0)=folder then
if not fso.folderexists(pathb(2)) then
fso.createfolder(pathb(2))
end if
elseif b(0)=file then
if fso.fileexists(pathb(2)) then
fso.deletefile(pathb(2))
end if
s2.position=0
s2.write(s.read(b(1)))
s2.seteos
s2.savetofile(pathb(2))
end if
i=i+1
wend

　　s.close
s1.close
s2.close
set s=nothing
set s1=nothing
set s2=nothing
set fso=nothing
if err.number<>0 then
response.write err.description
else
response.write 安装成功
end if
end function

　　%>

　　<%
文件名称：pack.asp
on error resume next
set fso=server.createobject(scripting.filesystemobject)
if fso.fileexists(server.mappath(./pack.jpg)) then
response.Write(pack.jpg已经存在)
response.End()
end if

　　dim str,s,s1,s2
set s=server.createobject(ADODB.Stream)
set s1=server.createobject(ADODB.Stream)
set s2=server.createobject(ADODB.Stream)

　　s.Open
s1.Open
s2.Open

　　s.Type=1
s1.type=1
s2.Type=2

　　call WriteFile(server.MapPath(./))

　　s2.charset=gb2312
s2.WriteText(str)
s2.Position=0
s2.type=1
s2.Position=0
bin=s2.Read

　　s2.Position=0
s2.type=2
s2.writeText(time=nowvbcrlf)
s2.writeText(size=s1.sizevbcrlf)
s2.writeText(run=request.Form(run)vbcrlf)
s2.seteos
s2.savetofile(server.mappath(./config.txt))

　　s1.write(bin)
s1.SetEOS
s1.SaveToFile(server.mappath(./pack.jpg))

　　s.close
s1.close
s2.close

　　set s=nothing
set s1=nothing
set s2=nothing

　　if err.number<>0 then
response.write err.description
else
response.Write(完成)
end if

　　Function WriteFile(folderspec)
Set fso = CreateObject(Scripting.FileSystemObject)
Set f = fso.GetFolder(folderspec)

　　Set fc = f.Files
For Each f1 in fc
str=strfile>f1.size>replace(folderspecf1.name,server.MapPath(./),)vbcrlf
s.LoadFromFile(folderspecf1.name)
img=s.Read()
s1.Write(img)
end if
Next

　　Set fc = f.SubFolders
For Each f1 in fc
str=strfolder>0>replace(folderspecf1.name,server.MapPath(./),)vbcrlf
WriteFile(folderspecf1.name)
Next

　　set fso=nothing
End Function
%>

ASP升级程序使用说明

　　本程序分两部分：
1、ASP文件打包程序pack.asp
把这个程序和要打包的程序放到一个目录下，然后运行pack.asp，得到pack.jpg和config.txt
2、ASP在线更新、下载、安装程序updata.asp
这个程序可以用来检查是否存在可用更新，和updata.asp同一目录要存在上面得到的config.txt，因为config里面有当前程序的安装日期，用来和网上的程序比较用的。
使用前，先修改updata.asp里的url变量的值，使其等于你存放升级程序的URL，运行updata.asp就可查看是否存在可用更新，如果存在就可用按着向导一步一步下载并安装更新了。

　　远程地址url下面存放用pack.asp得到的pack.jpg和config.txt

　　本程序