IDC资讯中心
抓取网页。偶要实现实实更新天气预报。利用了xmlhttp组件，抓取网页的指定部分。
需要分件html源代码
此例中的被抓取的html源代码如下
<p align=left>2004年8月24日星期二；白天：晴有时多云南风3—4级；夜间：晴南风3—4级；气温：最高29℃最低19℃ </p>
而程序中是从
以2004年8月24日为关键字搜索，直到</p>结速
而抓取的内容就变成了"2004年8月24日星期二；白天：晴有时多云南风3—4级；夜间：晴南风3—4级；气温：最高29℃最低19℃ "
干干净净的了。记录一下。
<%
on error resume next
server.scripttimeout=9999999
function gethttppage(path)
t = getbody(path)
gethttppage=bytestobstr(t,"gb2312")
end function
function getbody(url)
on error resume next
set retrieval = createobject("microsoft.xmlhttp")
with retrieval
.open "get", url, false, "", ""
.send
getbody = .responsebody
end with
set retrieval = nothing
end function
function bytestobstr(body,cset)
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 = cset
bytestobstr = objstream.readtext
objstream.close
set objstream = nothing
end function
function newstring(wstr,strng)
newstring=instr(lcase(wstr),lcase(strng))
if newstring<=0 then newstring=len(wstr)
end function
%>
<html>
<body bgcolor=#ffffff leftmargin=0 topmargin=0 marginheight=0 marginwidth=0>
<!– 开始 –>
<%
dim wstr,str,url,start,over,dtime
dtime=year(date)&"年"&month(date)&"月"&day(date)&"日"
url="http://www.qianhuaweb.com/"
wstr=gethttppage(url)
start=newstring(wstr,dtime)
over=newstring(wstr,"</p>")
body=mid(wstr,start,over-start)
response.write "<marquee onmouseover=this.stop(); onmouseout=this.start();>"&body&"</marquee>"
%>
<!– 结束 –>
</body></html>
