ASP write the program for downloading all resources in the webpage

%

Server.scripttimeout = 9999

Function Savetofile (from, Tofile)

On error resume next

dim geturl, objstream, imgs

geturl = trim (from)

Mybyval = getttpstr (geturl)

Set objstream = Server.createObject (Adodb.Stream)

objstream.type = 1

objstream.open

objstream.write mybyval

objstream.saVetofile Tofile, 2

objstream.close ()

set objstream = Nothing

if err.number <> 0 the err.clear

end function

Function geturlencodel (byval url) 'Chinese file name conversion

Dim i, code

geturlencodel =

if trim (url) = then exit function

for i = 1 to len (url)

CODE = ASC (MID (URL, I, 1))

if code <0 thatn code = code 65536

If code ＞ 255 then

Geturlencodel = geturlencodel &%& left (hex (code), 2) &%& right (hex (code), 2)

else

geturlencodel = geturlencodel & mid (url, i, 1)

end if

next

end function

Function Gethttppage (URL)

On error resume next

dim http

set http = server.createObject (msxml2.xmlhttp)

Http.open get, url, false

Http.send ()

if http.readyState <> 4 the exit function

Gethttppage = Bytes2BSTR (http.responsebody)

set http = nothing

if err.number <> 0 the err.clear

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 GetFilename (byval Filename)

If Instr (FILENAME,/) ＞ 0 THEN

filext_a = split (filename,/)

Getfilename = lcase (FileExt_a (ubound (filext_a))

If Instr (Getfilename,?) ＞ 0 THEN

getfilename = left (getfilename, Instr (getfilename,?)-1)

end if

else

getfilename = FILENAME

end if

end function

Function Gethttpstr (URL)

On error resume next

dim http

set http = server.createObject (msxml2.xmlhttp)

Http.open get, url, false

Http.send ()

if http.readyState <> 4 the exit function

Gethttpstr = http.responsebody

set http = nothing

if err.number <> 0 the err.clear

end function

Function CreateDir (byval LocalPath) to create a directory program, if there are multiple directory, then level and one level creation

On error resume next

LocalPath = replace (localpath, /, /)

Set fileobject = server.createObject (scripting.filesystemObject)

patharr = Split (LOCALPATH, /)

path_level = ubound (patharr)

For i = 0 to path_level

If i = 0 thatn pathtmp = patharr (0) & / else Pathtmp = Pathtmp & Patharr (i) & /

CPATH = Left (Pathtmp, Len (PATHTMP) - 1)

If Not FileObject.foldRexist (CPATH) The FileObject.createFolder CPATH

Next

Set fileObject = Nothing

If err.number <> 0 then

Createdir = false

Err.clear

Else

Createdir = true

End if

End function

Function GetFileext (byval Filename)

filext_a = split (filename ,.)

Getfileext = lcase (FileExt_a (ubound (filext_a))

end function

Function Getvirtual (Str, PATH, URLHEAD)

if left (str, 7) = http: // then

url = str

elseif left (str, 1) =/ then

Start = Instrrev (Str,/)

if Start = 1 THEN

url =/

else

url = left (str, start)

end if

url = urlhead & url

elseif left (str, 3) = ../ then

Str1 = MID (STR, Instrrev (Str, ../) 2) 2)

AR = Split (STR, ../)

lv = ubound (ar) 1

AR = Split (PATH,/)

url =/

for i = 1 to (ubound (ar) -lv)

url = url & ar (i)

next

url = url & str1

url = urlhead & url

else

url = urlhead & strong

end if

getvirtual = url

end function

'Example code

dim dlpath

virtual =/download/

truepath = Server.mappath (virtual)

if request (url) <> then

url = request (url)

fn = getfilename (url)

urlhead = left (url, (Instr (Replace (url, //,),/))

urlpath = replace (left (url, instrrev (url,/)), urlhead,)

Strcontent = Gethttppage (URL)

MyStr = Strcontent

Set objregexp = new regexp

objregexp.ignorecase = true

objregexp.global = true

objregexp.pattern = (src | href) =. [^/>?

Set matches = objregexp.execute (strcontent)

For Each Match in Matches

str = match.value

str = replace (str, src =,)

str = replace (str, href =,)

str = replace (str ,,)

str = replace (str, ',)

filename = getfilename (str)

getret = getvirtual (str, urlpath, urlhead)

temp = Replace (Getret, //, **)

Start = Instr (TEMP,/)

Endt = Instrrev (Temp,/)-Start 1

if Start ＞ 0 THEN

REPL = Virtual & Mid (Temp, Start) &

'Response.write repl & <br>

mystr = replace (mystr, str, repl)

DIR = MID (Temp, Start, Endt)

temp = truepath & replace (dir,/,/)

Createdir (TEMP)

'Response.write getret & || & Temp & Filename & <br> <br>

Savetofile getret, test & filename

end if

Next

set matches = nothing

end if

%>