ASP program can also upgrade online [Favorit]

<% 'File name: Updata.asp' remote address const url = "http: // localhost / test /"

Action = Request ("action") if action = "Updata" thndownload (URL & "config.txt") Download (URL & "Pack.jpg") response.write ("Download Success is mounted ") elseif action =" install "thenstr = openfile (" config.txt ") if str =" "then response.write" missing local configuration file config.txt "else size = RegExpTest (" size ", str) call install (" pack.jpg ", size) end ifelsestr = getpage (url &" config.txt ") if str =" "then response.write response" available updates or absence of local configuration is incorrect. " Endend IF

str1 = OpenFile ("config.txt") if str1 = "" "" "" "" "" "response.endendiff" in configness, config.txt, missing local profile config.txt

UpDataTime = Regexptest ("Time", Str) UpdataTime1 = Regexptest ("Time", Str1)

If Datediff ("D", UpDataTime1, Updataime> 0 Then Response.write ("There is available updates, updated, update date:" & updata.asp?A href='updata.asp?action=updata'> Download ") Else Response.write "Your program is the latest" End IFEND IF

function openfile (filename) set fso = server.CreateObject ( "scripting.filesystemobject") if fso.fileexists (server.MapPath (filename)) thenset f1 = fso.opentextfile (server.mappath (filename), 1, true) openfile = f1.readallf1.closeelseelseelseOpenFile = "" end ifset fso = Nothingend Function

function getpage (url) set xmlhttp = server.createobject ( "Microsoft.XMLHTTP") xmlhttp.open "get", url, falsexmlhttp.sendif xmlhttp.status <> 200 thengetpage = "" elsegetpage = bytes2BSTR (xmlhttp.ResponseBody) end ifend functionFunction bytes2BSTR (vIn) dim strReturndim i, ThisCharCode, NextCharCodestrReturn = "" For i = 1 To LenB (vIn) ThisCharCode = AscB (MidB (vIn, i, 1)) If ThisCharCode <& H80 ThenstrReturn = strReturn & Chr (ThisCharCode) ElseNextCharCode = ASCB (MIDB (VIN, I 1, 1)) Strreturn = Strreturn & Chr (ClNG (thischarcode) * & H100 CINT (NEXTCHARCODE)) i = i 1END IFNEXTBYTES2BSTR = STRETURNEEND FUNCTION

Function Regexptest (PATRN, STRNG) DIM Regex, Match, Matches' establishes variables. Set regex = new regexp 'establishes regular expressions. Regex.pattern = PATRN & "= (. ?) / n" set mode. Regex.ignoreCase = true 'Set whether you distinguish between characters. Regex.global = true 'Sets global availability. Set matches = regex.execute (strng) 'Executes your search. FOR Each Match In Matches' traverses matching collection. Retstr = match.valueneXTRegexptest = 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, falsexmlhttp.sendif 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 = filenamend ifset Xmlhttp = Nothingend FunctionFunction Install (filename, size) on error resume nextpath = 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.Opens1.opens2.open

S.TYPE = 1S1.TYPE = 1S2.TYPE = 1

S.LoadFromFile (server.mappath (filename)) s.position = sizes1.write (sready) s1.position = 0s1.type = 2s1.Charset = "gb2312" s1.position = 0A = split (S1.ReadText, VBCRLF) s.Position = 0

I = 0WHILE (i ") IF b (0) = "folder" Then if not fso.folderexists (Path & B (2)) THEN FSO.CREATEFOLDER Path & B (2)) end ifelseif b (0) = "File" Then IF fso.fileexists (Path & B)) THEN FSO.DELETEFILE (Path & B) end if s2.position = 0 s2.write (S. Read) (b (1))) S2.seos S2.Savetofile (Path & B (2)) End IFI = i 1Wends.closeS1.closeS2.Closet S = NothingSet S1 = NothingSet S2 = NothingSet FSO = Nothingif Err.Number <> 0 ThenResponse .write err.descriptionelsersponse.write "Install success" end ifend function

%>

<% 'File name: pack.aspon error resume next.com fso = server.createObject ("scripting.filesystemObject") if fso.mappath ("./ pack.jpg") "ThenResponse.write (" Pack.jpg Already ") Response.end () endiff

DIM STR, S, S1, S2SET S = Server.createObject ("AdoDb.Stream") Set S1 = Server.createObject ("AdoDb.Stream") Set S2 = Server.createObject ("AdoDb.Stream")

S.Opens1.opens2.open

S.TYPE = 1S1.TYPE = 1S2.TYPE = 2

Call writefile (Server.MAppath ("./"))

S2.Charset = "GB2312" S2.Writetext (str) s2.position = 0s2.type = 1s2.position = 0bin = s2.read ()

S2.Position = 0s2.type = 2s2.writetext ("Time =" & NOW & VBCRLF) S2.Writetext ("SIZE =" & S1.Size & VBCRLF) S2.WriteText ("Run =" & Request.Form ("RUN" & VBCRLF) S2. Seteoss2.savetofile (Server.mAppath ("./ Config.txt"))))

S1.write (bin) s1.seteoss1.savetofile (Server.MAppath ("./ pack.jpg")))

S.closeS1.closeS2.Close

SET S = NothingSet S1 = NothingSet S2 = Nothing

if err.number <> 0 thenresponse.write err.descriptionelseresponse.Write ( "complete") end ifFunction WriteFile (folderspec) Set fso = CreateObject ( "Scripting.FileSystemObject") Set f = fso.GetFolder (folderspec)

SET FC = F.FILESFOR EACH F1 IN FCIF F1.NAME <> "Pack.ASP" Then Str = STR & "File>" & F1.Size & "File> & Replace (Folderspec &" / "& f1.name, server.mappath (". / ")," ") & vbcrlf s.loadfromfile (folderspec &" / "& f1.name) img = s-read () s1.write (iv) end ifnext

SET FC = F.Subfoldersfor Each F1 in FC Str = Str & "Folder> 0>" & Replace (Folderspec & "/" & f1.name, server.mappath (".", """ "& f1 .name) Next

SET FSO = Nothingend Function%>

http://www.asp2004.net