分享
 
 
 

ASP在线升级程序

王朝asp·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

ASP在线升级程序

<%

'文件名:updata.asp

'远程地址

const url="http://localhost/test/"

action=request("action")

if action="updata" then

download(url&"config.txt")

download(url&"pack.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(url&"config.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&"=(.+?)\n"'设置模式。

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(path&b(2)) then

fso.createfolder(path&b(2))

end if

elseif b(0)="file" then

if fso.fileexists(path&b(2)) then

fso.deletefile(path&b(2))

end if

s2.position=0

s2.write(s.read(b(1)))

s2.seteos

s2.savetofile(path&b(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="&now&vbcrlf)

s2.writeText("size="&s1.size&vbcrlf)

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

if f1.name<>"pack.asp" then

str=str&"file>"&f1.size&">"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf

s.LoadFromFile(folderspec&"\"&f1.name)

img=s.Read()

s1.Write(img)

end if

Next

Set fc = f.SubFolders

For Each f1 in fc

str=str&"folder>0>"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf

WriteFile(folderspec&"\"&f1.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

本程序既可以用来做升级程序,当然如果原来安装目录下是空的,那就是一个完整的安装程序,^_^,也可以把updata.asp放到后台的首页里,这样每次登陆都可以自动检查是否有可用更新

注意:本地或者远程没有config.txt会导致程序不可用,以后会考虑加入这个容错机制。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有