function.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)
		case 9	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
		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"
		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"     )
	str = Replace(str,"http://astro.sina.com.cn"   , n&"AstroNews"   )
	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