ASP Online Upgrade Program

ASP Online Upgrade 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 ' > Installation </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 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 the 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
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