<%
'----------遠端取得內容,並將內容存在本機電腦上,包括任何檔案! ----------
'---------------利用xmlhttp和adodb.stream-----------------
'On Error Resume Next
'-------------------------------定義輸出格式--------------- --------------
path=request(path)
if path = then
path=http://pcqc.86516.com/index.asp
'這裡定義的網址是百度,,注意一定要有文件後綴
end if
sPath = Path
if left(lcase(path),7) <> http:// then
'-------------如果前面沒有http就是本機文件,交給LocalFile處理------------
LocalFile(path)
else
'--------------------否則為遠端文件,交給RemoteFile處理------------------
RemoteFile(Path)
end if
'Response.Write err.Description
'--------------處理函數-----------
sub LocalFile(Path)
'-------------------如果為本機檔案則簡單的跳到該頁面------------------ -
'Response.Redirect Path
Response.write 發生錯誤!
End Sub
Sub RemoteFile(sPath)
'-------------------------處理遠端檔案函數-------------------- ----------
FileName = GetFileName(sPath)
'-------------GetFileName為把位址轉換成符合條件的檔案名稱過程-------------
FileName = Server.MapPath(Cache/ & FileName)
Set objFso = Server.CreateObject(Scripting.FileSystemObject)
'Response.Write fileName
if objFso.FileExists(FileName) Then
'--------------檢查文件是否是已經訪問過,如是,則簡單跳轉------------
Response.Redirect cache/ & GetFileName(path)
Else
'----------------否則的話就先用GetBody函數讀取----------------------
'Response.Write Path
t = GetBody(Path)
'-----------------用二進位方法寫到瀏覽器上------------------------ --
Response.BinaryWrite t
Response.Flush
'-----------------輸出緩衝------------------------------ ------------
SaveFile t,GetFileName(path)
'------------------將文件內容快取到本機路徑,以待下次訪問-----------
End if
Set objFso = Nothing
End Sub
Function GetBody(url)
'-----------------------本函數為遠端取得內容的函數------------------ ---
'on error resume next
'Response.Write url
Set Retrieval = CreateObject(Microsoft.XMLHTTP)
'----------------------建立XMLHTTP物件------------------------ -----
With Retrieval
.Open Get, url, False, ,
'------------------用Get,非同步的方法發送-----------------------
.Send
'GetBody = .ResponseText
GetBody = .ResponseBody
'------------------函數傳回所取得的內容--------------------------
End With
Set Retrieval = Nothing
'response.Write err.Description
End Function
Function GetFileName(str)
'-------------------------本函數為合格化的檔名函數--------------- ----
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)
'-------------------------本函數為將流內容記憶體的函數--------------- ----
'on error resume next
Set objStream = Server.CreateObject(ADODB.Stream)
'--------------建立ADODB.Stream對象,必須要ADO 2.5以上版本---------
'objStream.Type = adTypeBinary
objStream.Type = 1
'-------------以二進位模式開啟-------------------------------- -----
objStream.Open
objstream.write str
'--------------------將字串內容寫入緩衝---------------------- ----
'response.Write fname
'路徑注意
objstream.SaveToFile E:/webroot/pcqc/vip/UploadFile/cache/&fName,2
'objstream.SaveToFile d:/cache/ & fName,adSaveCreateOverWrite
'--------------------將緩衝的內容寫入檔案---------------------- ----
'response.BinaryWrite objstream.Read
objstream.Close()
set objstream = nothing
'-----------------------關閉對象,釋放資源--------------------- ----
'response.Write err.Description
End sub
function saveimage(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttppage(geturl)'取得圖片的具休內容的過程
Set objStream = Server.CreateObject(ADODB.Stream)'建立ADODB.Stream對象,必須要ADO 2.5以上版本
objStream.Type =1'以二進位模式打開
objStream.Open
objstream.write imgs'將字串內容寫入緩衝
objstream.SaveToFile server.mappath(tofile),2'-將緩衝的內容寫入文件
objstream.Close()'關閉對象
set objstream=nothing
end function
%>