印 像 新 闻 系 统
数据库：
<%
dim cn,rs
set cn=server.CreateObject("adodb.connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("db\db.mdb")
%>
表名：NEWS
字段：ID 自动编号
NEWS OLE对像
表单页面：
function checkform()
{
if (document.ys.p.value=="")
{
alert("URL为空,请认真添写！");
document.ys.p.focus();
return false
}
}
</head>
<body>
<form action="xmlhttp.asp" method="post" name="ys" onSubmit="return checkform()">
URL:<input type="text" name="p" size="50">
<input type="submit" value="抓 取"> <a href="shownew.asp">显示新闻</a>
</form>
处理文件:
<%
Path=request("p")
sPath = Path
if left(lcase(path),7) <> "http://" then
-------------如果前面没有http就是本地文件，交给LocalFile处理------------
LocalFile(path)
else
--------------------否则为远程文件，交给RemoteFile处理------------------
RemoteFile(Path)
end if
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函数读取----------------------
t = GetBody(Path)
-----------------用二进制方法写到浏览器上--------------------------
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open "new",cn,3,2
rs.addnew
rs("body").appendchunk t
rs.update
Response.BinaryWrite t
Response.Flush
-----------------输出缓冲------------------------------------------
SaveFile t,GetFileName(path)
------------------将文件内容缓存到本地路径，以待下次访问-----------
End if
Set objFso = Nothing
End Sub
Function GetBody(url)
-----------------------本函数为远程获取内容的函数---------------------
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
----------------------建立XMLHTTP对象-----------------------------
With Retrieval
.Open "Get", url, False, "", ""
------------------用Get，异步的方法发送-----------------------
.Send
GetBody = .ResponseBody
------------------函数返回获取的内容--------------------------
End With
Set Retrieval = Nothing
End Function
Function GetFileName(str)
-------------------------本函数为合格化的文件名函数-------------------
str = Replace(lcase(str),"http://","")
str = Replace(lcase(str),"//","/")
str = Replace(str,"/","")
str = replace(str,vbcrlf,"")
x=split(str,"?")
str=x(0)
GetFileName = str
End Function
sub SaveFile(str,fName)
-------------------------本函数为将流内容存盘的函数-------------------
Set objStream = Server.CreateObject("ADODB.Stream")
--------------建立ADODB.Stream对象---------
objStream.Type = 1
-------------以二进制模式打开-------------------------------------
objStream.Open
objstream.write str
--------------------将字符串内容写入缓冲--------------------------
objstream.SaveToFile server.MapPath("UploadFile/Cache"&"\"&fName)&".htm",1
--------------------将缓冲的内容写入文件--------------------------
objstream.Close()
set objstream = nothing
-----------------------关闭对象，释放资源-------------------------
End sub
%>
