topx.asp

音乐类型的好网站

<style type="text/css">
<!--
body {  font-size: 12px}
-->
</style>
<%
Server.ScriptTimeOut=120

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

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

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

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

const Points="…"		'截取长度后的标题要跟的省略号样子，可不填。

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

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

dim wstr,str,url,start,over,i,News,n
n=0


'	on error resume next 
	url="http://dailynews.sina.com.cn/news1000.shtml"
	wstr=getHTTPPage(url) 
	if err.number=0 then
		start=newstring(wstr,"<!--新闻开始-->")
		over=newstring(wstr,"<!--新闻结束-->")
		wstr=mid(wstr,start+11,over-start-11)
		wstr=replace(wstr,"href=""","href=""show.asp?url=")
		wstr=replace(wstr,"<ul>","")
		wstr=trim(replace(wstr,"</ul>",""))							'完成对页面内容的截取加工
		<!--隐藏新浪的地址start-->
		wstr=Replace(wstr,"http://news.sina.com.cn","NewsNews")
		wstr=Replace(wstr,"http://tech.sina.com.cn","TechNews")
		wstr=Replace(wstr,"http://sports.sina.com.cn","SportsNews")
		wstr=Replace(wstr,"http://ent.sina.com.cn","EntNews")
		wstr=Replace(wstr,"http://eladies.sina.com.cn","EladiesNews")
		wstr=Replace(wstr,"http://auto.sina.com.cn","AutoNews")
		wstr=Replace(wstr,"http://finance.sina.com.cn","FinanceNews")
		<!--隐藏新浪的地址 end -->
'		Set fs = CreateObject("Scripting.FileSystemObject") 
'		Set f = fs.CreateTextFile(server.mappath("mynews.htm"))		
'		f.writeLine wstr 
'		f.close 
'		set f = nothing 
'		set fs = nothing 
		str=split(wstr,"<li>")
			for i=1 to Ubound(str)
			If n<m then
				If Instr( ShowType,Mid(str(i),2,2))>0 then
					News=News&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
					n=n+1
				End if
			End if
			Next
		Erase str
	else 
		wscript.echo err.description 
	end if 
		

	Sub writeLog(Msg) 
		On Error Resume Next 
		Dim f 
		Set f = fs.OpenTextFile(logfile,8,true) 
		f.WriteLine now & " - " & Msg 
		f.close 
	End Sub 
	function getHTTPPage(url) 
		on error resume next 
		dim http 
		set http=Server.createobject("Microsoft.XMLHTTP") 
		Http.open "GET",url,false 
		Http.send() 
		if Http.readystate<>4 then
			exit function 
		end if 
		getHTTPPage=bytes2BSTR(Http.responseBody) 
		set http=nothing
		if err.number<>0 then err.Clear  
	end function 

	Function bytes2BSTR(vIn) 
		dim strReturn 
		dim i,ThisCharCode,NextCharCode 
		strReturn = "" 
		For i = 1 To LenB(vIn) 
			ThisCharCode = AscB(MidB(vIn,i,1)) 
			If ThisCharCode < &H80 Then 
				strReturn = strReturn & Chr(ThisCharCode) 
			Else 
				NextCharCode = AscB(MidB(vIn,i+1,1)) 
				strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 
				i = i + 1 
			End If 
		Next 
		bytes2BSTR = strReturn 
	End Function 
	
	Function newstring(wstr,strng)
		newstring=Instr(wstr,strng)
	End Function
	
	Function LeftNews(strng,NewsLength,NeedTime)
		If NeedTime<>True then
			Left_0=Instr(strng,"</a>")+3
			TheRed=Instr(strng,"<font color=#ff0000>")
			If TheRed>0 then
				Left_1=Instr(strng,"<font color=#ff0000>")+20
				Left_2=Instr(strng,"</font>")
				If Left_1+NewsLength>=Left_2 then
					LeftNews=Left(strng,Left_0)
				Else
					LeftNews=Left(strng,Left_1+NewsLength)&Points&"</font></a>"
				End if
			Else
				Left_1=Instr(strng,"_blank>")+7
				Left_2=Instr(strng,"</a>")
				If Left_1+NewsLength>=Left_2 then
					LeftNews=Left(strng,Left_0)
				Else
					LeftNews=Left(strng,Left_1+NewsLength)&Points&"</a>"
				End if
			End if
		Else
			LeftNews=strng
		End if
	End Function
	
	
	Response.Write News '变量News为内容
%>