Program <%
' filename: updata.asp
' Remote address
Const url= "http://localhost/test/"
action=request ("action")
if action= "Updata" then
Download (url& "Config.txt")
Download (url& "pack.jpg")
Response. Write ("Download successful <a href= ' Updata.asp?action=install ' > Install </a>")
elseif action= "Install" then
str=openfile ("Config.txt")
if str= "" then
Response.Write "Missing local profile 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 "There is no available update or the local configuration is incorrect"
Response.End
End If
str1=openfile ("Config.txt")
if str1= "" then
Response.Write "Missing local profile Config.txt cannot learn about the local program installation time"
Response.End
End If
updatatime=regexptest ("Time", str)
updatatime1=regexptest ("Time", str1)
if DateDiff ("D", Updatatime1,updatatime) >0 then
Response. Write ("There are available updates, update date:" &updatatime& "<a href= ' updata.asp?action=updata ' > Download </a>")
Else
Response.Write "Your program is up to date"
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 ' establishes a variable.
Set regEx = New RegExp ' establishes a regular expression.
Regex.pattern = patrn& "= (. +?) \ n "' Set mode.
regex.ignorecase = True ' Sets whether character case is case-sensitive.
Regex.global = True ' Sets global availability.
Set matches = Regex.execute (strng) ' performs a search.
for the match in matches ' traversal matching collection.
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
WHI
