遠程擷取內容,並將內容存在本地電腦上,包括任何檔案!利用xmlhttp和adodb.stream,酷!絕對原創!

來源:互聯網
上載者:User
ado|stream|xml|原創 <%
'------------------------------------------------------------------------
'-------------------無垠網域: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),"//","/")
    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
  &nb



聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.