%
'----------遠(yuǎn)程獲取內(nèi)容，并將內(nèi)容存在本地電腦上，包括任何文件！----------
'---------------利用xmlhttp和adodb.stream-----------------
'On Error Resume Next
'-------------------------------定義輸出格式-----------------------------
path=request("path")
if path ="" then
path="http://pcqc.86516.com/index.asp"
'這里定義的網(wǎng)址是百度，，注意一定要有文件后綴
end if

sPath = Path
if left(lcase(path),7) > "http://" then
'-------------如果前面沒(méi)有http就是本地文件，交給LocalFile處理------------
LocalFile(path)
else
'--------------------否則為遠(yuǎn)程文件，交給RemoteFile處理------------------
RemoteFile(Path)
end if
'Response.Write err.Description
'--------------處理函數(shù)-----------

sub LocalFile(Path)
'-------------------如果為本地文件則簡(jiǎn)單的跳轉(zhuǎn)到該頁(yè)面-------------------
'Response.Redirect Path
Response.write "發(fā)生錯(cuò)誤！"
End Sub
Sub RemoteFile(sPath)
'-------------------------處理遠(yuǎn)程文件函數(shù)------------------------------
FileName = GetFileName(sPath)
'-------------GetFileName為把地址轉(zhuǎn)換為合格的文件名過(guò)程-------------
FileName = Server.MapPath("Cache/" FileName)
Set objFso = Server.CreateObject("Scripting.FileSystemObject")
'Response.Write fileName
if objFso.FileExists(FileName) Then
'--------------檢查文件是否是已經(jīng)訪問(wèn)過(guò),如是，則簡(jiǎn)單跳轉(zhuǎn)------------
Response.Redirect "cache/" GetFileName(path)
Else
'----------------否則的話(huà)就先用GetBody函數(shù)讀取----------------------
'Response.Write Path
t = GetBody(Path)
'-----------------用二進(jìn)制方法寫(xiě)到瀏覽器上--------------------------
Response.BinaryWrite t
Response.Flush
'-----------------輸出緩沖------------------------------------------
SaveFile t,GetFileName(path)
'------------------將文件內(nèi)容緩存到本地路徑，以待下次訪問(wèn)-----------
End if
Set objFso = Nothing
End Sub

Function GetBody(url)
'-----------------------本函數(shù)為遠(yuǎn)程獲取內(nèi)容的函數(shù)---------------------
'on error resume next
'Response.Write url
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
'----------------------建立XMLHTTP對(duì)象-----------------------------
With Retrieval
.Open "Get", url, False, "", ""
'------------------用Get，異步的方法發(fā)送-----------------------
.Send
'GetBody = .ResponseText
GetBody = .ResponseBody
'------------------函數(shù)返回獲取的內(nèi)容--------------------------
End With
Set Retrieval = Nothing
'response.Write err.Description
End Function

Function GetFileName(str)
'-------------------------本函數(shù)為合格化的文件名函數(shù)-------------------
str = Replace(lcase(str),"http://","")
str = Replace(lcase(str),"http://","/")
str = Replace(str,"?","")
str = Replace(str,"","")
str = Replace(str,"/","")
str = replace(str,vbcrlf,"")
GetFileName = str
End Function

sub SaveFile(str,fName)
'-------------------------本函數(shù)為將流內(nèi)容存盤(pán)的函數(shù)-------------------
'on error resume next
Set objStream = Server.CreateObject("ADODB.Stream")
'--------------建立ADODB.Stream對(duì)象，必須要ADO 2.5以上版本---------
'objStream.Type = adTypeBinary
objStream.Type = 1
'-------------以二進(jìn)制模式打開(kāi)-------------------------------------
objStream.Open
objstream.write str
'--------------------將字符串內(nèi)容寫(xiě)入緩沖--------------------------
'response.Write fname
'路徑注意
objstream.SaveToFile "E:\webroot\pcqc\vip\UploadFile\cache\"fName,2
'objstream.SaveToFile "d:\cache\" fName,adSaveCreateOverWrite
'--------------------將緩沖的內(nèi)容寫(xiě)入文件--------------------------
'response.BinaryWrite objstream.Read
objstream.Close()
set objstream = nothing
'-----------------------關(guān)閉對(duì)象，釋放資源-------------------------
'response.Write err.Description
End sub

function saveimage(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttppage(geturl)'取得圖片的具休內(nèi)容的過(guò)程
Set objStream = Server.CreateObject("ADODB.Stream")'建立ADODB.Stream對(duì)象，必須要ADO 2.5以上版本
objStream.Type =1'以二進(jìn)制模式打開(kāi)
objStream.Open
objstream.write imgs'將字符串內(nèi)容寫(xiě)入緩沖
objstream.SaveToFile server.mappath(tofile),2'-將緩沖的內(nèi)容寫(xiě)入文件
objstream.Close()'關(guān)閉對(duì)象
set objstream=nothing
end function
%>