1 <%
2 '文件名：updata.asp
3 '远程地址
4 const url="http://localhost/test/"
5
6 action=request("action")
7 if action="updata" then
8 download(url&"config.txt")
9 download(url&"pack.jpg")
10 response.Write("下载成功<a href='updata.asp?action=install'>安装</a>")
11 elseif action="install" then
12 str=openfile("config.txt")
13 if str="" then
14 response.write "缺少本地配置文件config.txt"
15 else
16 size=RegExpTest("size",str)
17 call install("pack.jpg",size)
18 end if
19 else
20 str=getpage(url&"config.txt")
21 if str="" then
22 response.write "不存在可用更新或者本地配置不正确"
23 response.end
24 end if
25
26 str1=openfile("config.txt")
27 if str1="" then
28 response.write "缺少本地配置文件config.txt无法获知本地程序的安装时间"
29 response.end
30 end if
31
32 updatatime=RegExpTest("time",str)
33 updatatime1=RegExpTest("time",str1)
34
35 if DateDiff("d",updatatime1,updatatime)>0 then
36 response.Write("存在可用更新，更新日期："&updatatime&"<a href='updata.asp?action=updata'>下载</a>")
37 else
38 response.write "您的程序是最新的了"
39 end if
40 end if
41
42 function openfile(filename)
43 set fso=server.CreateObject("scripting.filesystemobject")
44 if fso.fileexists(server.MapPath(filename)) then
45 set f1=fso.opentextfile(server.mappath(filename),1,true)
46 openfile=f1.readall
47 f1.close
48 else
49 openfile=""
50 end if
51 set fso=nothing
52 end function
53
54 function getpage(url)
55 set xmlhttp=server.createobject("Microsoft.XMLHTTP")
56 xmlhttp.open "get",url,false
57 xmlhttp.send
58 if xmlhttp.status<>200 then
59 getpage=""
60 else
61 getpage=bytes2BSTR(xmlhttp.ResponseBody)
62 end if
63 end function
64
65 Function bytes2BSTR(vIn)
66 dim strReturn
67 dim i,ThisCharCode,NextCharCode
68 strReturn = ""
69 For i = 1 To LenB(vIn)
70 ThisCharCode = AscB(MidB(vIn,i,1))
71 If ThisCharCode < &H80 Then
72 strReturn = strReturn & Chr(ThisCharCode)
73 Else
74 NextCharCode = AscB(MidB(vIn,i+1,1))
75 strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
76 i = i + 1
77 End If
78 Next
79 bytes2BSTR = strReturn
80 End Function
81
82 Function RegExpTest(patrn,strng)
83 Dim regEx,Match,Matches'建立变量。
84 Set regEx = New RegExp'建立正则表达式。
85 regEx.Pattern = patrn&"=(.+?)\n"'设置模式。
86 regEx.IgnoreCase = True'设置是否区分字符大小写。
87 regEx.Global = True'设置全局可用性。
88 Set Matches = regEx.Execute(strng)'执行搜索。
89 For Each Match in Matches'遍历匹配集合。
90 RetStr = Match.Value
91 Next
92 RegExpTest = replace(RetStr,patrn&"=","")
93 End Function
94
95 function download(url)
96 temp=split(url,"/")
97 filename=temp(ubound(temp))
98 set xmlhttp=server.createobject("Microsoft.XMLHTTP")
99 xmlhttp.open "get",url,false
100 xmlhttp.send
101 if xmlhttp.status<>200 then
102 download=""
103 else
104 set fso=server.createobject("scripting.filesystemobject")
105 if fso.fileexists(server.mappath(filename)) then
106 fso.deletefile(server.mappath(filename))
107 end if
108 set fso=nothing
109 img=xmlhttp.ResponseBody
110 set objAdostream=server.createobject("ADODB.Stream")
111 objAdostream.Open
112 objAdostream.type=1
113 objAdostream.Write(img)
114 objAdostream.SaveToFile(server.mappath(filename))
115 objAdostream.SetEOS
116 set objAdostream=nothing
117 download=filename
118 end if
119 set xmlhttp=nothing
120 end function
121
122
123 function install(filename,size)
124 on error resume next
125 path=server.mappath("./")
126
127 set fso=server.createobject("scripting.filesystemobject")
128
129 set s=server.createobject("adodb.stream")
130 set s1=server.createobject("adodb.stream")
131 set s2=server.createobject("adodb.stream")
132
133 s.open
134 s1.open
135 s2.open
136
137 s.type=1
138 s1.type=1
139 s2.type=1
140
141 s.loadfromfile(server.mappath(filename))
142 s.position=size
143 s1.write(s.read)
144 s1.position=0
145 s1.type=2
146 s1.charset="gb2312"
147 s1.position=0
148 a=split(s1.readtext,vbcrlf)
149 s.position=0
150
151 i=0
152 while(i<ubound(a))
153 b=split(a(i),">")
154 if b(0)="folder" then
155 if not fso.folderexists(path&b(2)) then
156 fso.createfolder(path&b(2))
157 end if
158 elseif b(0)="file" then
159 if fso.fileexists(path&b(2)) then
160 fso.deletefile(path&b(2))
161 end if
162 s2.position=0
163 s2.write(s.read(b(1)))
164 s2.seteos
165 s2.savetofile(path&b(2))
166 end if
167 i=i+1
168 wend
169
170 s.close
171 s1.close
172 s2.close
173 set s=nothing
174 set s1=nothing
175 set s2=nothing
176 set fso=nothing
177 if err.number<>0 then
178 response.write err.description
179 else
180 response.write "安装成功"
181 end if
182 end function
183
184 %>
185
186
187
188
189 --------------------------------------------------------------------------------
190
191
192 <%
193 '文件名称：pack.asp
194 on error resume next
195 set fso=server.createobject("scripting.filesystemobject")
196 if fso.fileexists(server.mappath("./pack.jpg")) then
197 response.Write("pack.jpg已经存在")
198 response.End()
199 end if
200
201 dim str,s,s1,s2
202 set s=server.createobject("ADODB.Stream")
203 set s1=server.createobject("ADODB.Stream")
204 set s2=server.createobject("ADODB.Stream")
205
206 s.Open
207 s1.Open
208 s2.Open
209
210 s.Type=1
211 s1.type=1
212 s2.Type=2
213
214 call WriteFile(server.MapPath("./"))
215
216 s2.charset="gb2312"
217 s2.WriteText(str)
218 s2.Position=0
219 s2.type=1
220 s2.Position=0
221 bin=s2.Read
222
223 s2.Position=0
224 s2.type=2
225 s2.writeText("time="&now&vbcrlf)
226 s2.writeText("size="&s1.size&vbcrlf)
227 s2.writeText("run="&request.Form("run")&vbcrlf)
228 s2.seteos
229 s2.savetofile(server.mappath("./config.txt"))
230
231 s1.write(bin)
232 s1.SetEOS
233 s1.SaveToFile(server.mappath("./pack.jpg"))
234
235 s.close
236 s1.close
237 s2.close
238
239 set s=nothing
240 set s1=nothing
241 set s2=nothing
242
243 if err.number<>0 then
244 response.write err.description
245 else
246 response.Write("完成")
247 end if
248
249 Function WriteFile(folderspec)
250 Set fso = CreateObject("Scripting.FileSystemObject")
251 Set f = fso.GetFolder(folderspec)
252
253 Set fc = f.Files
254 For Each f1 in fc
255 if f1.name<>"pack.asp" then
256 str=str&"file>"&f1.size&">"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf
257 s.LoadFromFile(folderspec&"\"&f1.name)
258 img=s.Read()
259 s1.Write(img)
260 end if
261 Next
262
263 Set fc = f.SubFolders
264 For Each f1 in fc
265 str=str&"folder>0>"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf
266 WriteFile(folderspec&"\"&f1.name)
267 Next
268
269 set fso=nothing
270 End Function
271 %>
272
273
274
275 --------------------------------------------------------------------------------
276
277 ASP升级程序使用说明
278
279 本程序分两部分：
280 1、ASP文件打包程序pack.asp
281 把这个程序和要打包的程序放到一个目录下，然后运行pack.asp，得到pack.jpg和config.txt
282 2、ASP在线更新、下载、安装程序updata.asp
283 这个程序可以用来检查是否存在可用更新，和updata.asp同一目录要存在上面得到的config.txt，因为config里面有当前程序的安装日期，用来和网上的程序比较用的。
284 使用前，先修改updata.asp里的url变量的值，使其等于你存放升级程序的URL，运行updata.asp就可查看是否存在可用更新，如果存在就可用按着向导一步一步下载并安装更新了。
285
286 远程地址url下面存放用pack.asp得到的pack.jpg和config.txt
287
288 本程序既可以用来做升级程序，当然如果原来安装目录下是空的，那就是一个完整的安装程序，^_^,也可以把updata.asp放到后台的首页里，这样每次登陆都可以自动检查是否有可用更新
289
290 注意：本地或者远程没有config.txt会导致程序不可用，以后会考虑加入这个容错机制。
291
292
2 '文件名：updata.asp
3 '远程地址
4 const url="http://localhost/test/"
5
6 action=request("action")
7 if action="updata" then
8 download(url&"config.txt")
9 download(url&"pack.jpg")
10 response.Write("下载成功<a href='updata.asp?action=install'>安装</a>")
11 elseif action="install" then
12 str=openfile("config.txt")
13 if str="" then
14 response.write "缺少本地配置文件config.txt"
15 else
16 size=RegExpTest("size",str)
17 call install("pack.jpg",size)
18 end if
19 else
20 str=getpage(url&"config.txt")
21 if str="" then
22 response.write "不存在可用更新或者本地配置不正确"
23 response.end
24 end if
25
26 str1=openfile("config.txt")
27 if str1="" then
28 response.write "缺少本地配置文件config.txt无法获知本地程序的安装时间"
29 response.end
30 end if
31
32 updatatime=RegExpTest("time",str)
33 updatatime1=RegExpTest("time",str1)
34
35 if DateDiff("d",updatatime1,updatatime)>0 then
36 response.Write("存在可用更新，更新日期："&updatatime&"<a href='updata.asp?action=updata'>下载</a>")
37 else
38 response.write "您的程序是最新的了"
39 end if
40 end if
41
42 function openfile(filename)
43 set fso=server.CreateObject("scripting.filesystemobject")
44 if fso.fileexists(server.MapPath(filename)) then
45 set f1=fso.opentextfile(server.mappath(filename),1,true)
46 openfile=f1.readall
47 f1.close
48 else
49 openfile=""
50 end if
51 set fso=nothing
52 end function
53
54 function getpage(url)
55 set xmlhttp=server.createobject("Microsoft.XMLHTTP")
56 xmlhttp.open "get",url,false
57 xmlhttp.send
58 if xmlhttp.status<>200 then
59 getpage=""
60 else
61 getpage=bytes2BSTR(xmlhttp.ResponseBody)
62 end if
63 end function
64
65 Function bytes2BSTR(vIn)
66 dim strReturn
67 dim i,ThisCharCode,NextCharCode
68 strReturn = ""
69 For i = 1 To LenB(vIn)
70 ThisCharCode = AscB(MidB(vIn,i,1))
71 If ThisCharCode < &H80 Then
72 strReturn = strReturn & Chr(ThisCharCode)
73 Else
74 NextCharCode = AscB(MidB(vIn,i+1,1))
75 strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
76 i = i + 1
77 End If
78 Next
79 bytes2BSTR = strReturn
80 End Function
81
82 Function RegExpTest(patrn,strng)
83 Dim regEx,Match,Matches'建立变量。
84 Set regEx = New RegExp'建立正则表达式。
85 regEx.Pattern = patrn&"=(.+?)\n"'设置模式。
86 regEx.IgnoreCase = True'设置是否区分字符大小写。
87 regEx.Global = True'设置全局可用性。
88 Set Matches = regEx.Execute(strng)'执行搜索。
89 For Each Match in Matches'遍历匹配集合。
90 RetStr = Match.Value
91 Next
92 RegExpTest = replace(RetStr,patrn&"=","")
93 End Function
94
95 function download(url)
96 temp=split(url,"/")
97 filename=temp(ubound(temp))
98 set xmlhttp=server.createobject("Microsoft.XMLHTTP")
99 xmlhttp.open "get",url,false
100 xmlhttp.send
101 if xmlhttp.status<>200 then
102 download=""
103 else
104 set fso=server.createobject("scripting.filesystemobject")
105 if fso.fileexists(server.mappath(filename)) then
106 fso.deletefile(server.mappath(filename))
107 end if
108 set fso=nothing
109 img=xmlhttp.ResponseBody
110 set objAdostream=server.createobject("ADODB.Stream")
111 objAdostream.Open
112 objAdostream.type=1
113 objAdostream.Write(img)
114 objAdostream.SaveToFile(server.mappath(filename))
115 objAdostream.SetEOS
116 set objAdostream=nothing
117 download=filename
118 end if
119 set xmlhttp=nothing
120 end function
121
122
123 function install(filename,size)
124 on error resume next
125 path=server.mappath("./")
126
127 set fso=server.createobject("scripting.filesystemobject")
128
129 set s=server.createobject("adodb.stream")
130 set s1=server.createobject("adodb.stream")
131 set s2=server.createobject("adodb.stream")
132
133 s.open
134 s1.open
135 s2.open
136
137 s.type=1
138 s1.type=1
139 s2.type=1
140
141 s.loadfromfile(server.mappath(filename))
142 s.position=size
143 s1.write(s.read)
144 s1.position=0
145 s1.type=2
146 s1.charset="gb2312"
147 s1.position=0
148 a=split(s1.readtext,vbcrlf)
149 s.position=0
150
151 i=0
152 while(i<ubound(a))
153 b=split(a(i),">")
154 if b(0)="folder" then
155 if not fso.folderexists(path&b(2)) then
156 fso.createfolder(path&b(2))
157 end if
158 elseif b(0)="file" then
159 if fso.fileexists(path&b(2)) then
160 fso.deletefile(path&b(2))
161 end if
162 s2.position=0
163 s2.write(s.read(b(1)))
164 s2.seteos
165 s2.savetofile(path&b(2))
166 end if
167 i=i+1
168 wend
169
170 s.close
171 s1.close
172 s2.close
173 set s=nothing
174 set s1=nothing
175 set s2=nothing
176 set fso=nothing
177 if err.number<>0 then
178 response.write err.description
179 else
180 response.write "安装成功"
181 end if
182 end function
183
184 %>
185
186
187
188
189 --------------------------------------------------------------------------------
190
191
192 <%
193 '文件名称：pack.asp
194 on error resume next
195 set fso=server.createobject("scripting.filesystemobject")
196 if fso.fileexists(server.mappath("./pack.jpg")) then
197 response.Write("pack.jpg已经存在")
198 response.End()
199 end if
200
201 dim str,s,s1,s2
202 set s=server.createobject("ADODB.Stream")
203 set s1=server.createobject("ADODB.Stream")
204 set s2=server.createobject("ADODB.Stream")
205
206 s.Open
207 s1.Open
208 s2.Open
209
210 s.Type=1
211 s1.type=1
212 s2.Type=2
213
214 call WriteFile(server.MapPath("./"))
215
216 s2.charset="gb2312"
217 s2.WriteText(str)
218 s2.Position=0
219 s2.type=1
220 s2.Position=0
221 bin=s2.Read
222
223 s2.Position=0
224 s2.type=2
225 s2.writeText("time="&now&vbcrlf)
226 s2.writeText("size="&s1.size&vbcrlf)
227 s2.writeText("run="&request.Form("run")&vbcrlf)
228 s2.seteos
229 s2.savetofile(server.mappath("./config.txt"))
230
231 s1.write(bin)
232 s1.SetEOS
233 s1.SaveToFile(server.mappath("./pack.jpg"))
234
235 s.close
236 s1.close
237 s2.close
238
239 set s=nothing
240 set s1=nothing
241 set s2=nothing
242
243 if err.number<>0 then
244 response.write err.description
245 else
246 response.Write("完成")
247 end if
248
249 Function WriteFile(folderspec)
250 Set fso = CreateObject("Scripting.FileSystemObject")
251 Set f = fso.GetFolder(folderspec)
252
253 Set fc = f.Files
254 For Each f1 in fc
255 if f1.name<>"pack.asp" then
256 str=str&"file>"&f1.size&">"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf
257 s.LoadFromFile(folderspec&"\"&f1.name)
258 img=s.Read()
259 s1.Write(img)
260 end if
261 Next
262
263 Set fc = f.SubFolders
264 For Each f1 in fc
265 str=str&"folder>0>"&replace(folderspec&"\"&f1.name,server.MapPath("./"),"")&vbcrlf
266 WriteFile(folderspec&"\"&f1.name)
267 Next
268
269 set fso=nothing
270 End Function
271 %>
272
273
274
275 --------------------------------------------------------------------------------
276
277 ASP升级程序使用说明
278
279 本程序分两部分：
280 1、ASP文件打包程序pack.asp
281 把这个程序和要打包的程序放到一个目录下，然后运行pack.asp，得到pack.jpg和config.txt
282 2、ASP在线更新、下载、安装程序updata.asp
283 这个程序可以用来检查是否存在可用更新，和updata.asp同一目录要存在上面得到的config.txt，因为config里面有当前程序的安装日期，用来和网上的程序比较用的。
284 使用前，先修改updata.asp里的url变量的值，使其等于你存放升级程序的URL，运行updata.asp就可查看是否存在可用更新，如果存在就可用按着向导一步一步下载并安装更新了。
285
286 远程地址url下面存放用pack.asp得到的pack.jpg和config.txt
287
288 本程序既可以用来做升级程序，当然如果原来安装目录下是空的，那就是一个完整的安装程序，^_^,也可以把updata.asp放到后台的首页里，这样每次登陆都可以自动检查是否有可用更新
289
290 注意：本地或者远程没有config.txt会导致程序不可用，以后会考虑加入这个容错机制。
291
292
浙公网安备 33010602011771号