?? function1.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 + -