ASP online Upgrade Program

<%
'File name: 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 slave configuration file 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 "no updates available or the local configuration is incorrect"
Response. End
End if

Str1 = openfile ("config.txt ")
If str1 = "" then
Response. write "the configuration file config.txt cannot know the installation time of the local program"
Response. End
End if

Updatatime = regexptest ("time", STR)
Updatatime1 = regexptest ("time", str1)

If datediff ("D", updatatime1, updatatime)> 0 then
Response. Write ("available updates, updated on:" & 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 'to create a variable.
Set RegEx = new Regexp 'to create a regular expression.
RegEx. pattern = patrn & "= (. + ?) /N "'setting mode.
RegEx. ignorecase = true' specifies whether the characters are case sensitive.
RegEx. Global = true' to set global availability.
Set matches = RegEx. Execute (strng) 'to execute the search.
For each match in matches 'traverses the matching set.
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 ())
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 "installation successful"
End if
End Function

%>

<%
'File name: Pack. asp
On Error resume next
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If FSO. fileexists (server. mappath ("./pack.jpg") then
Response. Write ("pack.jpg already exists ")
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 ("finished ")
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 upgrade procedure instructions

This program is divided into two parts:
1. asp package program pack. asp
Put this program and the program to be packaged into a directory, and then run pack.asp to get pack.jpg and config.txt.
2. asp online update, download, and install the program updata. asp
This program can be used to check whether there is a token available for updates. In the same way as updata.asp, the token must exist in config.txt, because the config contains the current program installation date, which is used in comparison with online programs.
Before use, modify updata. the value of the URL variable in ASP so that it is equal to the URL where you store the Upgrade Program and run updata. ASP can check whether there are available updates. If yes, you can download and install the updates step by step in the Wizard.

Pack.jpgand config.txt from pack.aspto are stored in the remote URL.

This program can be used for upgrading the program. Of course, if the original installation directory is empty, it is a complete installation program, ^ _ ^, you can also set updata. ASP is placed on the homepage of the background, so that every login can automatically check for Available Updates

Note: When zookeeper is not remotely configured with config.txt, the program becomes unavailable. In the future, we will consider adding this fault tolerance mechanism.

Author information:
QQ: 103895
Home: http://blog.csdn.net/iuhxq
Http://asp2004.net
Copyright Disclaimer: This program can be copied and used at will, but do not delete this information. Thank you!