远程获取内容，并将内容存在本地电脑上，包括任何文件
<%
'----------------------------------------------------------
'--------------无垠网域：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为把地址转换为合格的/webpage/asp/041101/47.htm过程-------
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)
'---------------本函数为合格化的/webpage/asp/041101/47.htm函数---------
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:\inetpub\myweb\uploadfile\cache\"
& fName,adSaveCreateOverWrite
'--------------------将缓冲的内容写入文件--------------
'response.BinaryWrite objstream.Read
objstream.Close()
set objstream = nothing
'-----------------------关闭对象，释放资源-------------
'response.Write err.Description
End sub
%>
作者：嘻哈呵嘿 出处：无垠网域 |
