»¶Ó­ÄúµÇ½²¢Ê¹ÓÃÖйú²ÆË°×ÉѯÖÐÐÄΪÄúÃâ·ÑÌṩµÄ×ÊÁÏ£¬½»Á÷£¬Ñ§Ï°ÎªÒ»ÌåµÄƽ̨£¡

Èç¹ûÄúÔÚʹÓÃÖÐÓöµ½Ê²Ã´ÎÊÌ⣬ÇëÄú²»ÒªÁßØÄ£¬Ò»¶¨ÒªÐ´ÐŸøÎÒÃÇ£¡£¡

Email:Shellapi@126.com ÆÚ´ýÄúµÄÀ´ÐÅ£¬»òÖ¸µ¼ÅúÓ

°ïÖúÄÚÄÑÃâÓÐÊÕ¼¯µÄ×ÊÁÏ£¬Èç¹ûÇÖ·¸ÁËÄúµÄ½öÁ¦£¬ÇëÄúÀ´ÐŸæÖª£¬ÎÒÃÇÂíÉÏɾ³ý»ò¸üд¦Àí£¡

ÎÄÕÂËÑË÷--ÇëÊäÈë¹Ø¼ü´Ê£º

ÎÒÏë×öÒ»¸öϵͳÄܹ»´ÓһЩ±ðµÄÍøÕ¾×¥ÐÂÎÅ£¬È»ºó¶¯Ì¬Ìí¼Óµ½ÎÒµÄÕ¾µãÉÏÀ´£¬ÇëÎÊÈçºÎʵÏÖ£¿
ÐÂÀ˵ÄÐÂÎÅץȡ
1¡£Ê×Ò³µ÷ÓÃ
<style type="text/css">
<!--
body {  font-size: 12px}
-->
</style>
<%
Server.ScriptTimeOut=120

'*********Ò³ÃæÉèÖò¿·Ö***********************************************************************

const m=40 'Ê×Ò³Áгö¶àÉÙÌõÐÂÎÅ

const NeedTime=False 'ÊÇ·ñÐèÒªÏÔʾʱ¼ä£¬True ±íʾÏÔʾʱ¼ä £¬ False ±íʾ²»ÏÔʾʱ¼ä

const NewsLength=20 'ÐÂÎűêÌâ½ØÈ¡³¤¶È(²»°üÀ¨Ê±¼ä)£¬×¢Òâ½ØÈ¡ÁËÐÂÎų¤¶È¾Í²»ÄÜÏÔʾÐÂÎÅʱ¼ä

const Points="¡­" '½ØÈ¡³¤¶ÈºóµÄ±êÌâÒª¸úµÄÊ¡ÂÔºÅÑù×Ó£¬¿É²»Ìî¡£

'*********************************************************************************************

dim wstr,str,url,start,over,i,News


on error resume next
url="http://dailynews.sina.com.cn/news1000.shtml"
wstr=getHTTPPage(url)
if err.number=0 then
start=newstring(wstr,"<!--ÐÂÎÅ¿ªÊ¼-->")
over=newstring(wstr,"<!--ÐÂÎŽáÊø-->")
wstr=mid(wstr,start+11,over-start-11)
wstr=replace(wstr,"<ul>","")
wstr=trim(replace(wstr,"</ul>",""))
' Set fs = CreateObject("Scripting.FileSystemObject")
' Set f = fs.CreateTextFile(server.mappath("mynews.htm"))
' f.writeLine wstr
' f.close
' set f = nothing
' set fs = nothing
str=split(wstr,"<li>")
If Unbound(str)<m then m=Unbound(str)
for i=1 to m
News=News&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
next
set str=nothing
else
wscript.echo err.description
end if


Sub writeLog(Msg)
On Error Resume Next
Dim f
Set f = fs.OpenTextFile(logfile,8,true)
f.WriteLine now & " - " & Msg
f.close
End Sub
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 newstring(wstr,strng)
newstring=Instr(wstr,strng)
End Function

Function LeftNews(strng,NewsLength,NeedTime)
If NeedTime<>True then
Left_0=Instr(strng,"</a>")+3
TheRed=Instr(strng,"<font color=#ff0000>")
If TheRed>0 then
Left_1=Instr(strng,"<font color=#ff0000>")+20
Left_2=Instr(strng,"</font>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</font></a>"
End if
Else
Left_1=Instr(strng,"_blank>")+7
Left_2=Instr(strng,"</a>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</a>"
End if
End if
Else
LeftNews=strng
End if
End Function


Response.Write News '±äÁ¿NewsΪÄÚÈÝ
%>
2¡£ÐÂÎÅÁбí
<style type="text/css">
<!--
body {  font-size: 12px}
-->
</style>

<a href="news.asp">Ê×Ò³</a>
<a href="news.asp?n=ÓéÀÖ">ÓéÀÖ</a>
<a href="news.asp?n=ÌåÓý">ÌåÓý</a>
<a href="news.asp?n=¹úÄÚ">¹úÄÚ</a>
<a href="news.asp?n=¿Æ¼¼">¿Æ¼¼</a>
<a href="news.asp?n=²Æ¾­">²Æ¾­</a>
<a href="news.asp?n=Éç»á">Éç»á</a>
<a href="news.asp?n=Æû³µ">Æû³µ</a>
<a href="news.asp?n=¹ú¼Ê">¹ú¼Ê</a>
<a href="news.asp?n=ÎĽÌ">ÎĽÌ</a>
<a href="news.asp?n=Ó°Òô">Ó°Òô</a>
<p>
<%
Server.ScriptTimeOut=120

'*********Ò³ÃæÉèÖò¿·Ö***********************************************************************

const m=10 'ÿ¸ö·ÖÀàµÄÐÂÎÅ×î¶à¼¸Ìõ

const NeedTime=False 'ÊÇ·ñÐèÒªÏÔʾʱ¼ä£¬True ±íʾÏÔʾʱ¼ä £¬ False ±íʾ²»ÏÔʾʱ¼ä

const NewsLength=20 'ÐÂÎűêÌâ½ØÈ¡³¤¶È(²»°üÀ¨Ê±¼ä)£¬×¢Òâ½ØÈ¡ÁËÐÂÎų¤¶È¾Í²»ÄÜÏÔʾÐÂÎÅʱ¼ä

const Points="¡­" '½ØÈ¡³¤¶ÈºóµÄ±êÌâÒª¸úµÄÊ¡ÂÔºÅÑù×Ó£¬¿É²»Ìî¡£

'*********************************************************************************************

dim wstr,str,url,start,over,NewsClass,i
dim n0,n1,n2,n3,n4,n5,n6,n7,n8,n9
n0=0
n1=0
n2=0
n3=0
n4=0
n5=0
n6=0
n7=0
n8=0
n9=0

NewsClass=trim(Request("n"))

on error resume next
url="http://dailynews.sina.com.cn/news1000.shtml" 'ÐÂÎÅÀ´Ô´µÄÒ³Ãæ
wstr=getHTTPPage(url) 'È¡µÃÒ³ÃæÄÚÈÝ
if err.number=0 then
start=newstring(wstr,"<!--ÐÂÎÅ¿ªÊ¼-->")
over=newstring(wstr,"<!--ÐÂÎŽáÊø-->")
wstr=mid(wstr,start+11,over-start-11)
wstr=replace(wstr,"href=""","href=""show.asp?url=")
wstr=replace(wstr,"<ul>","")
wstr=trim(replace(wstr,"</ul>","")) 'Íê³É¶ÔÒ³ÃæÄÚÈݵĽØÈ¡¼Ó¹¤
' Set fs = CreateObject("Scripting.FileSystemObject")
' Set f = fs.CreateTextFile(server.mappath("mynews.htm"))
' f.writeLine wstr
' f.close
' set f = nothing
' set fs = nothing
str=split(wstr,"<li>")
If NewsClass<>"" then '¶Ô·ÖÀàÐÂÎŵĽØÈ¡
for i=1 to Ubound(str)
If Left(str(i),4)="["&NewsClass&"]" then
News=News&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
End if
next
Else '¶ÔËùÓÐÐÂÎŽøÐзÖÀà
for i=1 to Ubound(str)
If     Left(str(i),4)="[ÓéÀÖ]" then
If n0<m then YuLe=YuLe&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n0=n0+1
Elseif Left(str(i),4)="[ÌåÓý]" then
If n1<m then TiYu=TiYu&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n1=n1+1
Elseif Left(str(i),4)="[¹úÄÚ]" then
If n2<m then GuoNei=GuoNei&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n2=n2+1
Elseif Left(str(i),4)="[¿Æ¼¼]" then
If n3<m then KeJi=KeJi&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n3=n3+1
Elseif Left(str(i),4)="[²Æ¾­]" then
If n4<m then CaiJing=CaiJing&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n4=n4+1
Elseif Left(str(i),4)="[Éç»á]" then
If n5<m then SheHui=SheHui&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n5=n5+1
Elseif Left(str(i),4)="[Æû³µ]" then
If n6<m then QiChe=QiChe&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n6=n6+1
Elseif Left(str(i),4)="[¹ú¼Ê]" then
If n7<m then GuoJi=GuoJi&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n7=n7+1
Elseif Left(str(i),4)="[Ó°Òô]" then
If n8<m then YingYin=YingYin&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n8=n8+1
Elseif Left(str(i),4)="[ÎĽÌ]" then
If n9<m then WenJiao=WenJiao&"<li>"&LeftNews(str(i),NewsLength,NeedTime)
n9=n9+1
End if
next
End if
set str=nothing
else
wscript.echo err.description
end if

Sub writeLog(Msg)
On Error Resume Next
Dim f
Set f = fs.OpenTextFile(logfile,8,true)
f.WriteLine now & " - " & Msg
f.close
End Sub
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 newstring(wstr,strng)
newstring=Instr(wstr,strng)
End Function

Function LeftNews(strng,NewsLength,NeedTime)
If NeedTime<>True then
Left_0=Instr(strng,"</a>")+3
TheRed=Instr(strng,"<font color=#ff0000>")
If TheRed>0 then
Left_1=Instr(strng,"<font color=#ff0000>")+20
Left_2=Instr(strng,"</font>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</font></a>"
End if
Else
Left_1=Instr(strng,"_blank>")+7
Left_2=Instr(strng,"</a>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</a>"
End if
End if
Else
LeftNews=strng
End if
End Function

'ÿ¸ö±äÁ¿´ú±íÒ»¸ö·ÖÀàµÄÐÂÎÅ

Response.Write YuLe&"<p>"
Response.Write TiYu&"<p>"
Response.Write GuoNei&"<p>"
Response.Write KeJi&"<p>"
Response.Write CaiJing&"<p>"
Response.Write SheHui&"<p>"
Response.Write QiChe&"<p>"
Response.Write GuoJi&"<p>"
Response.Write YingYin&"<p>"
Response.Write WenJiao
'±äÁ¿NewsÊÇÑ¡Ôñ·ÖÀàÐÂÎźóµÄ±äÁ¿
Response.Write News

%>
3¡£ÐÂÎÅÄÚÈÝ
<%
Server.ScriptTimeOut=60
dim wstr,url,start,over,i


on error resume next
url=Request("url")
wstr=getHTTPPage(url)
if err.number=0 then
wstr=Autolink(wstr) 'Íê³É½ØÈ¡ºóµÄÒ³Ãæ
' Set fs = CreateObject("Scripting.FileSystemObject") '°Ñ½ØÏÂÀ´µÄÒ³ÃæдÔÚÒ»¸öÎļþÀï
' Set f = fs.CreateTextFile(server.mappath("mynews.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,"ÿ/p>","") 'È¥µôÒ³ÃæÖÐÒ»¸öÆæ¹ÖµÄ´íÎó
strContent = Replace(strContent,"<table width=604 border=0 cellpadding=0 cellspacing=0>","")
strContent = Replace(strContent,"</table></table>","")
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 = "<table width=100% border=0 cellspacing=0 cellpadding=10 align=center >"&strContent&"</td></tr></table>" 'ÐÞ²¹HTMLµÄ½á¹¹´íÎó
Else 'ÆäËû·ÖÀàÐÂÎŵĽçÃæ
start=NewsString(strContent,"<th class=f24>") '½ØÈ¡µÄÆðµã
over=NewsString(strContent,"<br clear=all>") '½ØÈ¡µÄÖÕµã
strContent=mid(strContent,start,over-start) '½ØÈ¡ÐÂÎÅ
re.Pattern = "\<table border=0(.[^\[]*)\<\/table>"
strContent = re.Replace(strContent,"") 'È¥µô»­Öл­¹ã¸æ
strContent = Replace(strContent,"ÿ/p>","") 'È¥µôÒ³ÃæÖÐÒ»¸öÆæ¹ÖµÄ´íÎó
strContent = "<table width=100% border=0 cellspacing=0 cellpadding=10 align=center >"&strContent&"</td></tr></table>" 'ÐÞ²¹HTMLµÄ½á¹¹´íÎó
End if
Autolink=strContent
End Function

%>
<style type="text/css">
<!--
td {  font-size: 12px}
-->
</style>
<table width="770" border="0" cellspacing="0" cellpadding="10" align="center" class="line_l_r" bgcolor="#EEEEEE">
  <tr>
    <td>
  <% Response.Write wstr %>

</td>
  </tr>
</table>