<%
'---------- Obtain the content remotely and store the content on the local computer, including any files! ----------
'--------------- Use XMLHTTP and ADODB. Stream -----------------
'On error resume next
'------------------------------- Define the output format -----------------------------
Path = request ("path ")
If Path = "" then
Path = "http://pcqc.86516.com/index.asp"
'The website defined here is Baidu. Note that there must be a file suffix.
End if
Spath = path
If left (lcase (PATH), 7) <> "http: //" then
'------------- If there is no HTTP before, it is a local file. submit it to localfile for processing ------------
Localfile (PATH)
Else
'------------------ Otherwise, the remote file will be handed to remotefile for processing ------------------
Remotefile (PATH)
End if
'Response. Write err. Description
'-------------- Processing function -----------
Sub localfile (PATH)
'------------------- If the file is a local file, you can simply jump to this page -------------------
'Response. Redirect path
Response. Write "error! "
End sub
Sub remotefile (Spath)
'------------------------- Remote File Processing Function ------------------------------
Filename = getfilename (Spath)
'------------- Getfilename is the process of converting an address to a qualified file name -------------
Filename = server. mappath ("cache/" & filename)
Set objfso = server. Createobject ("scripting. FileSystemObject ")
'Response. Write filename
If objfso. fileexists (filename) then
'-------------- Check whether the file has been accessed. If yes, simply jump ------------
Response. Redirect "cache/" & getfilename (PATH)
Else
'---------------- Otherwise, use the getbody function to read ----------------------
'Response. Write path
T = getbody (PATH)
'----------------- Write data in binary format to the browser --------------------------
Response. binarywrite t
Response. Flush
'----------------- Output buffer ------------------------------------------
SaveFile T, getfilename (PATH)
'---------------- Cache the file content to the local path for the next visit -----------
End if
Set objfso = nothing
End sub
Function getbody (URL)
'----------------------- This function is a function for remotely obtaining content ---------------------
'On error resume next
'Response. Write URL
Set retrieval = Createobject ("Microsoft. XMLHTTP ")
'---------------------- Create an XMLHTTP object -----------------------------
With Retrieval
. Open "get", URL, false ,"",""
'---------------- Use the get, Asynchronous Method to send -----------------------
. Send
'Getbody =. responsetext
Getbody =. responsebody
'---------------- The retrieved content returned by the function --------------------------
End
Set retrieval = nothing
'Response. Write err. Description
End Function
Function getfilename (STR)
'------------------------- This function is a qualified file name function -------------------
STR = Replace (lcase (STR), "http ://","")
STR = Replace (lcase (STR ),"//","/")
STR = Replace (STR ,"? ","")
STR = Replace (STR ,"&","")
STR = Replace (STR ,"/","")
STR = Replace (STR, vbcrlf ,"")
Getfilename = Str
End Function
sub SaveFile (STR, fname)
'------------------------- this function is the function of saving stream content to disk -------------------
' on error resume next
set objstream = server. createobject ("ADODB. stream ")
'------------ create an ADODB. stream object, must be ADO 2.5 or a later version ---------
'objstream. type = adtypebinary
objstream. type = 1
'------------- open in binary mode -------------------------------------
objstream. open
objstream. write STR
'------------------ write string content to buffer ------------------------
'response. write fname
'path note
objstream. savetofile "E: \ webroot \ pcqc \ VIP \ uploadfile \ cache \" & fname, 2
'objstream. savetofile "D: \ cache \" & fname, adsavecreateoverwrite
'-------------------- write the buffered content to the file ------------------------
'response. binarywrite objstream. read
objstream. close ()
set objstream = nothing
'----------------------- close the object and release the resource -----------------------
'response. write err. description
end sub
function saveimage (from, tofile)
dim geturl, objstream, IMGs
geturl = trim (from)
IMGs = gethttppage (geturl) 'process of getting the rest content of the image
set objstream = server. createobject ("ADODB. stream ") 'create ADODB. stream object, must be ADO 2.5 or later
objstream. type = 1' open in binary mode
objstream. open
objstream. write IMGs write the string content into the buffer
objstream. savetofile server. mappath (tofile), 2'-writes buffered content to a file
objstream. close () 'close the object
set objstream = nothing
end function
%>