show.asp

音乐类型的好网站

<%
	Server.ScriptTimeOut=60
	dim wstr,url,start,over,i

	<!--取的并解析新闻地址 start-->
	url=Request("url")
	If Instr(url,"NewsNews")>0 then
		url=Replace(url,"NewsNews","http://news.sina.com.cn")
		NewsType="http://news.sina.com.cn"
	End if
	If Instr(url,"TechNews")>0 then
		url=Replace(url,"TechNews","http://tech.sina.com.cn")
		NewsType="http://tech.sina.com.cn"
	End if
	If Instr(url,"SportsNews")>0 then
		url=Replace(url,"SportsNews","http://sports.sina.com.cn")
		NewsType="http://sports.sina.com.cn"
	End if
	If Instr(url,"EntNews")>0 then
		url=Replace(url,"EntNews","http://ent.sina.com.cn")
		NewsType="http://ent.sina.com.cn"
	End if
	If Instr(url,"EladiesNews")>0 then
		url=Replace(url,"EladiesNews","http://eladies.sina.com.cn")
		NewsType="http://eladies.sina.com.cn"
	End if
	If Instr(url,"AutoNews")>0 then
		url=Replace(url,"AutoNews","http://auto.sina.com.cn")
		NewsType="http://auto.sina.com.cn"
	End if
	If Instr(url,"FinanceNews")>0 then
		url=Replace(url,"FinanceNews","http://finance.sina.com.cn")
		NewsType="http://finance.sina.com.cn"
	End if
	<!--取的并解析新闻地址 end-->
	


	on error resume next 
	wstr=getHTTPPage(url) 
	if err.number=0 then
		wstr=Autolink(wstr)	'完成截取后的页面
'		Set fs = CreateObject("Scripting.FileSystemObject")
'		Set f = fs.CreateTextFile(server.mappath("mynews1.htm"))		
'		f.writeLine wstr 
'		f.close 
'		set f = nothing
'		set fs = nothing 
	else 
		wscript.echo err.description 
	end if 
	
		
	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 NewsString(wstr,strng)
		NewsString=Instr(wstr,strng)
	End Function
	
	Function Autolink(strContent)
		dim re
		set re = New RegExp	
		re.IgnoreCase = True
		re.Global = True
		If Instr(url,"http://ent.")>0 then		'影音和娱乐新闻的界面
			start=NewsString(strContent,"<table width=604")				'截取的起点
			over=NewsString(strContent,"<center></center>")				'截取的终点
			strContent=mid(strContent,start,over-start)					'截取新闻
			re.Pattern = "\<table border=0(.[^\[]*)\<\/table>"	
			strContent = re.Replace(strContent,"")						'去掉画中画广告
			strContent = Replace(strContent,"