sub.asp

商务世纪新闻asp源代码

<%
Dim ImgNewsChina,ImgNewsWorld,ImgNewsSociety,ImgNewsSports,ImgNewsEnt,ImgNewsEladies
Sub GetImgNews(theType)
	Dim ImgNewsUrl,ImgNewsFile,pstr,str,s
	ImgNewsUrl=GetContent(GetPage("http://news.sina.com.cn/photo/imp/"),"URL=",">",0)
	ImgNewsFile=Replace(ImgNewsUrl,"http://news.sina.com.cn/photo/imp/","")
	ImgNewsFile=Replace(ImgNewsFile,"/index","")
	If not IsExists("ImgNews/"&ImgNewsFile) then
		pstr = GetPage(ImgNewsUrl)
		pstr = GetContent(pstr,"<!-- 图片列表 begin -->","<!-- 图片列表 end -->",0)
		pstr = Replace(pstr,"border=2","border=1")
		pstr = VirtualURL(pstr,"show.asp?url=")
		call WriteToFile("ImgNews/"&ImgNewsFile,pstr)
		str = GetContent(pstr,"<!-- 国内 begin -->","<!-- 国内 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsChina.htm",wstr)
		End if
		str = GetContent(pstr,"<!-- 国际 begin -->","<!-- 国际 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsWorld.htm",wstr)
		End if
		str = GetContent(pstr,"<!-- 社会 begin -->","<!-- 社会 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsSociety.htm",wstr)
		End if
		str = GetContent(pstr,"<!-- 体育 begin -->","<!-- 体育 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsSports.htm",wstr)
		End if
		str = GetContent(pstr,"<!-- 娱乐 begin -->","<!-- 娱乐 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsEnt.htm",wstr)
		End if
		str = GetContent(pstr,"<!-- 时尚女性 begin -->","<!-- 时尚女性 end -->",0)
		str = GetContent(str,"<table width=96","",5)
		s = split( str ,"<a " )
		wstr = ""
		for i=1 to ubound(s)/2
		wstr = wstr&"<a "&GetContent(s(i),"</a>","",4)&"<a "&GetContent(s(i+ubound(s)/2),"</a>","",4)
		Next
		If wstr<>"" then
		call WriteToFile("Template/ImgNewsEladies.htm",wstr)
		End if
	End if
	select case theType
	case "china"
	ImgNewsChina   = ReadAllTextFile("Template/ImgNewsChina.htm")
	case "world"
	ImgNewsWorld   = ReadAllTextFile("Template/ImgNewsWorld.htm")
	case "society"
	ImgNewsSociety = ReadAllTextFile("Template/ImgNewsSociety.htm")
	case "sports"
	ImgNewsSports  = ReadAllTextFile("Template/ImgNewsSports.htm")
	case "ent"
	ImgNewsEnt     = ReadAllTextFile("Template/ImgNewsEnt.htm")
	case "eladies"
	ImgNewsEladies = ReadAllTextFile("Template/ImgNewsEladies.htm")
	case "all"
	ImgNewsChina   = ReadAllTextFile("Template/ImgNewsChina.htm")
	ImgNewsWorld   = ReadAllTextFile("Template/ImgNewsWorld.htm")
	ImgNewsSociety = ReadAllTextFile("Template/ImgNewsSociety.htm")
	ImgNewsSports  = ReadAllTextFile("Template/ImgNewsSports.htm")
	ImgNewsEnt     = ReadAllTextFile("Template/ImgNewsEnt.htm")
	ImgNewsEladies = ReadAllTextFile("Template/ImgNewsEladies.htm")
	end select
End sub


Sub GetHomeNews()
	dim pstr,wstr,s
	pstr = GetPage("http://news.sina.com.cn")
	pstr = VirtualURL(pstr,"show.asp?url=")
	
	wstr = GetContent(pstr,"<a name=china>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	wstr = Replace(wstr,"href=""/","href=""show.asp?url=NewsNews/")
	s = split( wstr ,"<li>" )
	NewsChina=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		If NewsTime=True then
		NewsChina=NewsChina&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		Else
		NewsChina=NewsChina&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		End if
		End if
	Next
	NewsChina=Right(NewsChina,Len(NewsChina)-4)
	wstr = GetContent(pstr,"<a name=world>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	wstr = Replace(wstr,"href=""/","href=""show.asp?url=NewsNews/")
	s = split( wstr ,"<li>" )
	NewsWorld=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		If NewsTime=True then
		NewsWorld=NewsWorld&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		Else
		NewsWorld=NewsWorld&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		End if
		End if
	Next
	NewsWorld=Right(NewsWorld,Len(NewsWorld)-4)
	wstr = GetContent(pstr,"<a name=sports>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	s = split( wstr ,"<li>" )
	NewsSports=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		If NewsTime=True then
		NewsSports=NewsSports&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		Else
		NewsSports=NewsSports&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		End if
		End if
	Next
	NewsSports=Right(NewsSports,Len(NewsSports)-4)
	wstr = GetContent(pstr,"<a name=tech>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	s = split( wstr ,"<li>" )
	NewsTech=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		'If NewsTime=True then
		'NewsTech=NewsTech&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		'Else
		NewsTech=NewsTech&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		'End if
		End if
	Next
	NewsTech=Right(NewsTech,Len(NewsTech)-4)
	wstr = GetContent(pstr,"<a name=finance>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	s = split( wstr ,"<li>" )
	NewsFinance=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		'If NewsTime=True then
		'NewsFinance=NewsFinance&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		'Else
		NewsFinance=NewsFinance&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		'End if
		End if
	Next
	NewsFinance=Right(NewsFinance,Len(NewsFinance)-4)
	wstr = GetContent(pstr,"<a name=ent>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	s = split( wstr ,"<li>" )
	NewsEnt=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		If NewsTime=True then
		NewsEnt=NewsEnt&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		Else
		NewsEnt=NewsEnt&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		End if
		End if
	Next
	NewsEnt=Right(NewsEnt,Len(NewsEnt)-4)
	wstr = GetContent(pstr,"<a name=society>","class=news4>全部</a>",0)
	wstr = GetContent(wstr,"<li>","",3)
	wstr = GetContent(wstr,"</FONT>","",4)
	s = split( wstr ,"<li>" )
	NewsSociety=""
	for i=1 to ubound(s)
		If i<=NewsMax then
		If NewsTime=True then
		NewsSociety=NewsSociety&"<br>"&GetContent(s(i),")","",4)&chr(13)&chr(10)
		Else
		NewsSociety=NewsSociety&"<br>"&GetContent(s(i),"</a>","",6)&chr(13)&chr(10)
		End if
		End if
	Next
	NewsSociety=Right(NewsSociety,Len(NewsSociety)-4)
End sub

sub WeatherShow()
	on error resume next
	Dim TheDay,strContent,sm,ssm,Insert,usm
	If Hour(Time)>=18 then
		TheDay=Year( Date() )&AddZero( Month(Date()),2 )&AddZero( Day(Date()),2 )
	Else
		TheDay=Year(DateAdd("d",-1,Date()))&AddZero(Month(DateAdd("d",-1,Date())),2)&AddZero(Day(DateAdd("d",-1,Date())),2)
	End if
	If ( not IsExists("WeatherRecord/"&TheDay&".txt") ) then
		strContent=GetPage("http://www.grmc.gov.cn/tqyb/inland.html")
		Today=Mid(strContent,Instr(strContent,"(")+1,Instr(strContent,"时")-Instr(strContent,"(")-4)
		Today=Replace(Today,".","-")
		strContent=Right(strContent,Len(strContent)-Instr(strContent,"天气状况"))
		strContent=Replace(strContent,"<font color=#0000ff>","")
		strContent=Replace(strContent,"</font>","")
		strContent=Replace(strContent,"</TD>","")
		strContent=Replace(strContent,"</TR>","")
		strContent=Replace(strContent,"</TR>","")
		strContent=Replace(strContent,"</table>","")
		strContent=Replace(strContent,"</center>","")
		strContent=Replace(strContent,"</body>","")
		strContent=Replace(strContent,"</html>","")
		strContent=Replace(strContent,"<p>","")
		strContent=Replace(strContent,"</body>","")
		strContent=Replace(strContent,chr(10),"")
		strContent=Replace(strContent,chr(13),"")
		sm=split(strContent,"<TR>")
		usm=ubound(sm)
		Insert = "<script language=""VBScript"" type=""text/VBScript"">"&chr(13)
		If usm=0 then
			Insert = Insert & "Dim WeatherArray(0,4)"&chr(13)
			Insert = Insert & "Dim Today"&chr(13)
			Insert = Insert & "Today="""&Date()&""""&chr(13)
			Insert = Insert & "WeatherArray(0,0)=""暂无"""&chr(13)