topx-kj.asp

商务世纪新闻asp源代码

<!--#include file="set.asp" -->
<!--#include file="function.asp" -->
<%
On Error Resume Next
Server.ScriptTimeOut=10

'*********页面设置部分***********************************************************************

const m=10				'首页列出多少条新闻

const NeedTime=False	'是否需要显示时间，True 表示显示时间 ， False 表示不显示时间

const NewsLength=10		'新闻标题截取长度(不包括时间)，注意截取了新闻长度就不能显示新闻时间

const ShowTypeX="科技"	'您希望显示的分类，用逗号隔开，共有以下几类：娱乐,体育,科技,财经,社会,汽车,影音,国内,国际,文教

const NewsExTime=4		'多少秒重新取一次数据

'*********************************************************************************************

Sub GetHttpNews()
	Dim fso, f ,n , DateLastModified , wstr , pstr ,News
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.GetFile(Server.MapPath("Template/news.htm"))
	DateLastModified = cdate(f.DateLastModified)
	Set f = nothing
	Set fso= nothing
	If DateDiff("s",DateLastModified,Now())>NewsExTime then
		pstr=GetPage("http://news.sina.com.cn/news1000/index.shtml")
		wstr = GetContent(pstr,"<!--新闻开始-->","<!--新闻结束-->",0)
		wstr = Replace(wstr,"<ul>","")
		wstr = VirtualURL(wstr,HomePage&"show.asp?url=")
		wstr=Replace(wstr,"""","")
		wstr=Replace(wstr,"'","’")
		Set fs = CreateObject("Scripting.FileSystemObject") 
		Set f = fs.CreateTextFile(Server.MapPath("Template/news.htm"))		
		f.WriteLine wstr
		f.close 
		set f = nothing 
		set fs = nothing 
	Else
		wstr = ReadAllTextFile("Template/news.htm")
	End if
	str=split(wstr,"<li>")
		for i=1 to Ubound(str)
		If n<m then
			If Instr(ShowTypeX,Mid(str(i),2,2))>0 then
				News=News&"<tr><td>"&LeftNews(str(i),NewsLength,false)&"</td></tr>"
				n=n+1
			End if
		End if
		Next
	Erase str
	News=Replace(News,chr(10),"")
	News=Replace(News,chr(13),"")
	News=Replace(News,chr(10)&chr(13),"")
	Response.Write "joynewskj.innerHTML=""<table border=0 cellspacing=0 cellpadding=2 >"&News&"</table>"""
End sub

call GetHttpNews()
%>