Download all content on a remote page 1th/2 page _asp Basics

Source: Internet
Author: User
Tags chr set time trim

Download all content on the remote page at once
Use the method to save the above code as one such as: downfile.asp
Enter on the browser:
http://your address,/downfile.asp?url=http://www.baidu.com/index.html.

<%
' 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

Current 1/2 page 12 Next read the full text

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.