深圳升蓝软件
数据库开发 .Net技术  |  ASP技术 PHP技术 JSP技术 应用技术类   
Hiblue Software

远程获取内容,并将内容存在本地电脑上,包括任何文件


March 25,2004
<%
'------------------------------------------------------------------------
'-------------------无垠网域:http://www.5inet.net/ ---------------------
'-------------------作者:嘻哈呵嘿 ,[email protected] -----------------
'----------远程获取内容,并将内容存在本地电脑上,包括任何文件!----------
'---------------利用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
    '--------------------将字符串内容写入缓冲--------------------------
    'response.Write fname
    objstream.SaveToFile "c:inetpubmywebuploadfilecache" & fName,adSaveCreateOverWrite
    '--------------------将缓冲的内容写入文件--------------------------
    'response.BinaryWrite objstream.Read
    objstream.Close()
    set objstream = nothing
    '-----------------------关闭对象,释放资源-------------------------
'response.Write err.Description
End sub
%>
Copyright © 2001-2008 Shenzhen Hiblue Software Team All rights reserved