program | download | Download read an article about downloading pictures in the Web page, it can only download the image of HTTP headers, I made some improvements, you can download all the connection resources in the Web page, and according to the directory structure of the Web page to build a local directory, storage resources.
Download.asp?url= the page you want to download
The download.asp code is as follows:
<%
server.scripttimeout=9999
function SaveToFile (from,tofile)
On Error Resume Next
Dim Geturl,objstream,imgs
Geturl=trim (from)
Mybyval=gethttpstr (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 then err. Clear
End Function
Function Geturlencodel (ByVal URL) ' Chinese filename 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 Then 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 then Exit function
Gethttppage=bytes2bstr (Http.responsebody)
Set http=nothing
If Err.Number <> 0 then 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
Fileext_a=split (filename, "/")
Getfilename=lcase (Fileext_a (UBound (fileext_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 then Exit function
Gethttpstr=http.responsebody
Set http=nothing
If Err.Number <> 0 then err. Clear
End Function
Function Createdir (ByVal localpath) ' Directory-building program, if there is a multilevel directory, then 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 Then pathtmp = Patharr (0) & "/" Else pathtmp = pathtmp & Patharr (I) & "/"
CPath = Left (pathtmp, Len (pathtmp)-1)
If not fileobject.folderexists (cpath) Then 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)
Fileext_a=split (FileName, ".")
Getfileext=lcase (Fileext_a (UBound (fileext_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, str,instrrev). /") +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&str
End If
Getvirtual=url
End Function
' Sample code
Dim Dlpath
Virtual= "/downweb/"
Truepath=server. MapPath (virtual)
If Request ("url") <> "then
Url=request ("url")
Fn=getfilename (URL)
Urlhead=left (URL, (InStr (Replace (URL, "//", ""), "/") +1)
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 the 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=
