Using ASP program to download all contents of remote pages to local

program | download | page

I've sent a thing before, is the remote content, according to the browser input, it into binary streaming down to the local, but more limitations, this code can be a remote page of all content, including remote server css,js,jpg,gif, the first layer of the following page, SWF, and so on ...

Use of code:

Save the following code as Downfile.asp put it in a directory on your site, and then create a folder called Downfile in that directory, and all the content will be saved in the Downfile folder.

Enter in the browser

http://your address,/downfile.asp?url=http://www.baidu.com/index.html.

Then the Baidu home page all the files are downloaded to the local folder called Downfile.

This code is much more comfortable than your manual oe, and will get the files to the original remote path, create a folder, categories to save the file.

<%
'####################
' The main function part of the code is derived from the network
'####################
' Set time to timeout
server.scripttimeout=9999
'##############
' File Save function
'#############
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

'##############
' Character processing substitution
'#############
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
'##############
' XML get remote page start
'#############
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
'##############
' XML gets the remote page end, which is a common part of the Thief program
'#############

'##############
' Decompose address, get filename
'#############
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

'##############
' Get the remote page 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

'##############
' FSO processing function, creating a directory
'#############
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

'##############
' How to get the virtual path
'#############
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

' Here's the demo code
Dim Dlpath
' Create a folder in which to store the retrieved data
Virtual= "/downfile/"
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=mid (Temp,start,endt)
Temp=truepath&replace (dir, "/", "\")
Createdir (temp)
Response. Write getret& "| |" &temp&filename& "<br>"
Response. Write "successfully obtained" &filename& "This file <br>"
Response. Write and save &filename& in &temp& <br><br>
Response. Write "<HR>"
SaveToFile Getret,temp&filename
End If
Next
Set matches=nothing
Else
Response.Write "Please enter an address!"
End If
%>