效果：
天气:多云
温度:23 ℃～14 ℃
风向：西风 转 西南风
风力:4-5级
Response.write GetWeather("苏州","Sina")
Function GetWeather(CityStr,SiteKey)
dim Rurl,TakenHTML
if SiteKey="Sohu" then
Rurl="http://weather.news.sohu.com/hd.php"
else
Rurl="http://weather.sina.com.cn/images/figureWeather/map/eastOfChina.html"
end if
TakenHTML = GetPageContent(Rurl)
Response.Flush
Select case SiteKey
case "Sina"
GetWeather=GetContent(TakenHTML,"drawcitys(' 城市:"&CityStr&"市 <br>","'); return true;",0)
case "Sohu"
GetWeather=GetContent(TakenHTML,"城市:"&CityStr&"",""">",0)
case else
GetWeather=GetContent(TakenHTML,"drawcitys(' 城市:"&CityStr&"市 <br>","'); return true;",0)
end Select
End Function
Function GetPageContent(Url)
Dim HTTPObj
On Error Resume Next
Set HTTPObj = Server.CreateObject("Microsoft.XMLHTTP")
With HTTPObj
.Open "Get", Url, False, "", ""
.Send
End With
if HTTPObj.Readystate <> 4 then
Set HTTPObj = Nothing
GetPageContent = False
Exit Function
end if
GetPageContent = ResponseStrToStr(HTTPObj.ResponseBody)
Set HTTPObj = Nothing
End Function
Function ResponseStrToStr(BodyStr)
Dim ADOStreamObj
Set ADOStreamObj = Server.CreateObject("ADODB.Stream")
ADOStreamObj.Type = 1
ADOStreamObj.Mode = 3
ADOStreamObj.Open
ADOStreamObj.Write BodyStr
ADOStreamObj.Position = 0
ADOStreamObj.Type = 2
ADOStreamObj.Charset = "GB2312"
ResponseStrToStr = ADOStreamObj.ReadText
ADOStreamObj.Close
Set ADOStreamObj = Nothing
End Function
Function GetContent(Str,StartStr,LastStr,Flag)
Dim SearchIndex
On Error Resume Next
if Instr(LCase(Str),LCase(StartStr)) > 0 then
Select Case Flag
Case 0
GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) - Len(StartStr) + 1)
SearchIndex = Instr(LCase(GetContent),LCase(LastStr))
if SearchIndex <= 0 then
GetContent = ""
else
GetContent = Left(GetContent,SearchIndex - 1)
end if
Case 1
GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) + 1)
GetContent = Left(GetContent,Instr(LCase(GetContent),LCase(LastStr)) + Len(LastStr) - 1)
Case 2
GetContent = Right(Str,Len(Str) - Instr(lcase(Str),LCase(StartStr))-Len(StartStr) + 1)
Case else
GetContent = ""
End Select
else
GetContent = ""
end if
if Err.Number <> 0 then GetContent = ""
End Function
[此贴子已经被作者于2005-4-20 16:44:04编辑过]
