利用xmlhttp和adodb.stream加快取技術下載遠端Web文件

<%

'----------遠端取得內容，並將內容存在本機電腦上，包括任何檔案！ ----------

'---------------利用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

%>