获取天气预报信息

网络整理 - 08-16
http://community.csdn.net/Expert/topic/3720/3720043.xml?temp=.9098169

<form method=post action="weareport.asp">
城市:<input name=city value=''哈尔滨''><br/>
地区:<input name=area value=''东北''><br/>
省份:<input name=province value=''黑龙江''><br/>
<input type=submit value=''查看''>
</form>
<%
if request("city")<>"" then
city=request("city")
area=request("area")
province=request("province")
contents=getHTTPpage("?city="&city&"&province="&province&"&area="&area)
startPos=CutedPage(contents,"<!--天气预报开始-->",1)
endPos=CutedPage(contents,"<!--天气预报结束-->",0)
contents=mid(contents,startPos,endPos-startPos)
contents=replace(contents,"src=/","src=http://www.cma.gov.cn/")
contents=replace(contents,"src=..","src=http://www.cma.gov.cn/netcenter_news/qxyb/city/..")
response.write contents
end if

function CutedPage(scontent,str,mode)
if scontent="" then exit function
pos=instr(scontent,str)
if pos>=0 then
if mode=0 then
CutedPage=pos
else
CutedPage=pos+len(str)
end if
else
Cutepage=len(scontent)
end if
end function

Function Bytes2Bstr2(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
Bytes2Bstr2 = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

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
getHTTPPage=bytes2BSTR2(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function
%>