获取天气预报信息

<form method=post action="weareport.asp">
城市:<input name=city value=''哈尔滨''>

地区:<input name=area value=''东北''>

省份:<input name=province value=''黑龙江''>

<input type=submit value=''查看''>
</form>
<%
if request("city")<>"" then
city=request("city")
area=request("area")
province=request("province")
contents=getHTTPpage("http://www.cma.gov.cn/netcenter_news/qxyb/city/index.php?city="&city&a ... p;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 
%>

转载保留链接！网址：http://80920140.com/post/88.html