⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 function1.asp

📁 商务世纪新闻asp源代码
💻 ASP
字号:
🔍 
<%
Server.ScriptTimeout=10

Function GetPage(url) 
	Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
	With Retrieval 
	.Open "Get", url, False, "", "" 
	.Send 
	GetPage = BytesToBstr(.ResponseBody)
	End With 
	Set Retrieval = Nothing 
End Function

Function BytesToBstr(body)
	dim objstream
	set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write body
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = "GB2312"
	BytesToBstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
End Function

Function GetContent(str,start,last,n)
	If Instr(lcase(str),lcase(start))>0 then
		select case n
		case 0	'左右都截取（都取前面）（去处关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
		case 1	'左右都截取（都取前面）（保留关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
		case 2	'只往右截取（取前面的）（去除关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		case 3	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		case 4	'只往左截取（取后面的）（包含关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
		case 5	'只往左截取（取后面的）（去除关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
		case 6	'只往左截取（取前面的）（包含关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
		case 7	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
		case 8	'只往左截取（取前面的）（去除关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
		end select
	Else
		GetContent=""
	End if
End function

Function GetRefreshUrl(str)

End function

Function DeHttpdata(strContent,filterstr)
	Dim re
	set re = New RegExp	
	re.IgnoreCase = True
	re.Global = True
	s = split(filterstr,"|")
	For each key in s
	re.Pattern=key
	strContent=re.Replace(strContent,"")
	Next
	DeHttpdata=strContent
	'例子 <body.+?>
End Function

Function GetUrl(theDate,theType)
	If not IsDate(theDate) then theDate=Date()
	select case theType
	case "sports"
		GetUrl="http://sports.sina.com.cn/date_"&Year(theDate)&"/"&Month(theDate)&"."&AddZero(Day(theDate),2)&".shtml"
	case "china"
		GetUrl="http://news.sina.com.cn/china/"&Year(theDate)&"-"&Month(theDate)&"-"&AddZero(Day(theDate),2)&"/index.shtml"
	case "world"
		GetUrl="http://news.sina.com.cn/world/"&Year(theDate)&"-"&Month(theDate)&"-"&AddZero(Day(theDate),2)&"/index.shtml"
	case "society"
		GetUrl="http://news.sina.com.cn/society/"&Year(theDate)&"-"&Month(theDate)&"-"&AddZero(Day(theDate),2)&"/index.shtml"
	case "tech"
		If theDate=Date() then GetUrl="http://tech.sina.com.cn/roll.shtml" Else	GetUrl="http://tech.sina.com.cn/oldnews/"&Year(theDate)&"-"&AddZero(Month(theDate),2)&"-"&AddZero(Day(theDate),2)&".shtml"
	case "finance"
		GetUrl="http://finance.sina.com.cn/oldnews/"&Year(theDate)&"-"&AddZero(Month(theDate),2)&"-"&AddZero(Day(theDate),2)&".html"
	case "ent"
		If theDate=Date() then theDate=Date()-1
		GetUrl="http://ent.sina.com.cn/news"&Year(theDate)&AddZero(Month(theDate),2)&AddZero(Day(theDate),2)&".shtml"
	case "jczs"
		GetUrl="http://jczs.sina.com.cn/"
	case "jczswaijun"
		GetUrl="http://jczs.sina.com.cn/waijun/index.shtml"
	case "jczsxingshi"
		GetUrl="http://jczs.sina.com.cn/xingshi/index.shtml"
	case "jczsxinwen"
		GetUrl="http://jczs.sina.com.cn/xinwen/index.shtml"
	case "jczszonghe"
		GetUrl="http://jczs.sina.com.cn/zonghe/index.shtml"
	case "jczspingshu"
		GetUrl="http://jczs.sina.com.cn/pingshu/index.shtml"
	case "jczsjiyu"
		GetUrl="http://jczs.sina.com.cn/jiyu/index.shtml"
	case "jczsjunshi"
		GetUrl="http://jczs.sina.com.cn/junshi/index.shtml"
	case "jczszongheng"
		GetUrl="http://jczs.sina.com.cn/zongheng/index.shtml"
	case "jczsjunqing"
		GetUrl="http://jczs.sina.com.cn/junqing/index.shtml"
	case "jczsshijiao"
		GetUrl="http://jczs.sina.com.cn/shijiao/index.shtml"
	case "jczsjunli"
		GetUrl="http://jczs.sina.com.cn/junli/index.shtml"
	case "eladies"
		If theDate=Date() then theDate=Date()-1
		GetUrl="http://www.eladies.com.cn/news/"&Year(theDate)&AddZero(Month(theDate),2)&AddZero(Day(theDate),2)&".shtml"
	case "new"
		GetUrl="http://news.sina.com.cn/news1000/"
	case "newall"
		GetUrl="http://news.sina.com.cn/old1000/news1000_"&Year(theDate)&AddZero(Month(theDate),2)&AddZero(Day(theDate),2)&".shtml"
	end select
End function

Function VirtualURL(str,n)
	str = Replace(str,"http://news.sina.com.cn"    , n&"NewsNews"    )
	str = Replace(str,"http://tech.sina.com.cn"    , n&"TechNews"    )
	str = Replace(str,"http://sports.sina.com.cn"  , n&"SportsNews"  )
	str = Replace(str,"http://ent.sina.com.cn"     , n&"EntNews"     )
	str = Replace(str,"http://eladies.sina.com.cn" , n&"EladiesNews" )
	str = Replace(str,"http://auto.sina.com.cn"    , n&"AutoNews"    )
	str = Replace(str,"http://finance.sina.com.cn" , n&"FinanceNews" )
	str = Replace(str,"http://www.eladies.com.cn"  , n&"wwwEladies"  )
	str = Replace(str,"http://edu.sina.com.cn"     , n&"EduNews"     )
	str = Replace(str,"http://jczs.sina.com.cn"    , n&"JczsNews"    )
	str = Replace(str,"http://newbbs0.sina.com.cn" , n&"NewBBS0"     )
	VirtualURL = str
End function

Function Urldns(url)
	If Instr(url,"NewsNews")>0 then
		urldns=Replace(url,"NewsNews","http://news.sina.com.cn")
	Elseif Instr(url,"TechNews")>0 then
		urldns=Replace(url,"TechNews","http://tech.sina.com.cn")
	Elseif Instr(url,"SportsNews")>0 then
		urldns=Replace(url,"SportsNews","http://sports.sina.com.cn")
	Elseif Instr(url,"EntNews")>0 then
		urldns=Replace(url,"EntNews","http://ent.sina.com.cn")
	Elseif Instr(url,"EladiesNews")>0 then
		urldns=Replace(url,"EladiesNews","http://eladies.sina.com.cn")
	Elseif Instr(url,"AutoNews")>0 then
		urldns=Replace(url,"AutoNews","http://auto.sina.com.cn")
	Elseif Instr(url,"FinanceNews")>0 then
		urldns=Replace(url,"FinanceNews","http://finance.sina.com.cn")
	Elseif Instr(url,"wwwEladies")>0 then
		urldns=Replace(url,"wwwEladies","http://www.eladies.com.cn")
	Elseif Instr(url,"EduNews")>0 then
		urldns=Replace(url,"EduNews","http://edu.sina.com.cn")
	Elseif Instr(url,"JczsNews")>0 then
		urldns=Replace(url,"JczsNews","http://jczs.sina.com.cn")
	Elseif Instr(url,"NewBBS0")>0 then
		urldns=Replace(url,"NewBBS0","http://newbbs0.sina.com.cn")
	End if
End function

Function Autolink(strContent,url)
	dim re
	set re = New RegExp	
	re.IgnoreCase = True
	re.Global = True
	If Instr(url,"http://ent.")>0 then		'影音和娱乐新闻的界面
		strContent = GetContent(strContent,"<div id=article>","</div>",0)
		strContent = GetContent(strContent,"<center></center>","",8)
		strContent = Replace(strContent,"<table width=604 border=0 cellpadding=0 cellspacing=0>","<table width=100% border=0 cellpadding=0 cellspacing=0>")
		strContent = Replace(strContent,"<img src=http://image2.sina.com.cn/ent/news_rou.gif width=30 height=53>","")
		strContent = Replace(strContent,"<img src=http://image2.sina.com.cn/ent/images/c.gif width=1 height=1>","<hr size=1 bgcolor=#d9d9d9>")
		strContent = Replace(strContent,"bgcolor=#fff3ff","")											'去掉背景颜色
		strContent = Replace(strContent,"bgcolor=#bd6bff","")											'去掉背景颜色
		strContent = Replace(strContent,"width=603","width=100% ")										'把一个定义了大小的表格放到最大
		strContent = Replace(strContent,"width=554","width=100% ")										'把一个定义了大小的表格放到最大
		strContent = Replace(strContent,"width=472","")													'把一个定义了大小的表格放到最大
		strContent = Replace(strContent,"width=102","")													'把一个定义了大小的表格放到最大
		strContent = Replace(strContent,"src=/","src=http://ent.sina.com.cn/")							'修改图片的连接地址
		strContent = Replace(strContent,"src=""/","src=""http://ent.sina.com.cn/")						'修改图片的连接地址
		strContent = Replace(strContent,"href=/","href=show.asp?url=EntNews/")							'修改图片的连接地址
		strContent = Replace(strContent,"href=http://ent.sina.com.cn/","href=show.asp?url=EntNews/")	'修改图片的连接地址
		strContent = Replace(strContent,"href=""/","href=""show.asp?url=EntNews/")						'修改图片的连接地址
		strContent = Replace(strContent,"href=""http://ent.sina.com.cn/","href=""show.asp?url=EntNews/")'修改图片的连接地址
		strContent = strContent&"</table></td></tr></table>"											'修补HTML的结构错误
	Elseif Instr(url,"http://eladies.")>0 or Instr(url,"http://www.eladies.")>0 then
		If Instr(strContent,"<tr valign=top><td width=602>")>0 then
			strContent = GetContent(strContent,"<tr valign=top><td width=602>","</td><td width=10></td></tr>",1)
			re.Pattern = "\<!--PipAD:start-->(.[^\[]*)\<!--PipAD:end-->"	
			strContent = re.Replace(strContent,"")						'去掉画中画广告
			strContent=Replace(strContent,"width=470","width=100% ")
			strContent=strContent&"</td></tr></table></table>"
		End if
		If Instr(strContent,"<tr><td class=f21")>0 then
			strContent = GetContent(strContent,"<tr><td class=f21","</td><td width=15></td></tr>",1)
			re.Pattern = "\<!--PipAD:start-->(.[^\[]*)\<!--PipAD:end-->"	
			strContent = re.Replace(strContent,"")						'去掉画中画广告
			strContent="<table>"&strContent&"</table>"
		End if
	Elseif Instr(url,"newbbs0.sina.com.cn")>0 then
		strContent = GetContent(strContent,"<div id=article>","</div>",0)
	Else									'其他分类新闻的界面
		strContent = GetContent(strContent,"<th class=f24>","<br clear=all>",1)
		strContent = "<table width=100% border=0 cellspacing=0 cellpadding=10 align=center ><tr>"&strContent&"</td></tr></table>"						'修补HTML的结构错误
	End if
	strContent = Replace(strContent,GetContent(strContent,"<!--NEWSZW_HZH_BEGIN-->","<!--NEWSZW_HZH_END-->",1),"")
	If Instr(strContent,"<!--画中画广告开始-->")>0 and Instr(strContent,"<!--画中画广告结束-->")>0 then
	strContent = Left(strContent,Instr(strContent,"<!--画中画广告开始-->"))&Right(strContent,Len(strContent)-Instr(strContent,"<!--画中画广告结束-->"))
	End if
	strContent = Replace(strContent,"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -