'------------------------------------------------------------------------
'-------------------無垠網域：http://www.5inet.net/ ---------------------
'-------------------作者：嘻哈呵嘿 ,webmaster@5inet.net -----------------
'----------遠程獲取內容，并將內容存在本地電腦上，包括任何文件！----------
'---------------利用xmlhttp和adodb.stream,酷！絕對原創！-----------------
'On Error Resume Next
'Set the content type to the specific type that you are sending.
'Response.ContentType = "IMAGE/JPEG"
'-------------------------------定義輸出格式-----------------------------
Path=request.querystring("p")
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
End Sub
Sub RemoteFile(sPath)
'-------------------------處理遠程文件函數------------------------------
FileName = GetFileName(sPath)
'-------------GetFileName為把地址轉換為合格的文件名過程-------------
FileName = Server.MapPath("/UploadFile/Cache/" & FileName)
Set objFso = Server.CreateObject("Scripting.FileSystemObject")
'Response.Write fileName
if objFso.FileExists(FileName) Then
'--------------檢查文件是否是已經訪問過,如是，則簡單跳轉------------
Response.Redirect "/uploadfile/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),"http://","/")
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.Open
objstream.write str
'--------------------將字符串內容寫入緩沖--------------------------
'response.Write fname
objstream.SaveToFile "c:\inetpub\myweb\uploadfile\cache\" & fName,adSaveCreateOverWrite
'--------------------將緩沖的內容寫入文件--------------------------
'response.BinaryWrite objstream.Read
objstream.Close()
set objstream = nothing
'-----------------------關閉對象，釋放資源-------------------------
'response.Write err.Description
End sub
%>
文章來源于領測軟件測試網 http://www.kjueaiud.com/
