风讯官方论坛

首页 » FoosunCMS交流区 » 插件讨论 » [原创]精品贈送：可结合风讯的城市天气预报标签函数。

XdSSoft - 2005-4-20 16:40:00

效果：

天气:多云
温度: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编辑过]

XdSSoft - 2005-4-20 16:41:00

嘿嘿。我要精华和金币。吼吼。。。

A君 - 2005-4-20 16:42:00

效果，效果，。。。。看到效果就给你加

XdSSoft - 2005-4-20 16:43:00

汗。。。。

网路游侠 - 2005-4-20 16:46:00

很好  行货

爱我的资格 - 2005-4-20 16:46:00

呵呵，我已经试过了，拿来就能用，直接执行就可以了

XdSSoft - 2005-4-20 16:53:00

呵呵。。本来就是嘛。

存为ASP文件就能用了。自已改成标签就行了。

[此贴子已经被作者于2005-4-20 16:57:10编辑过]

lukyvivi - 2005-4-20 17:00:00

你应该说的详细一些,要不然很多人可能一头雾水呀.比如,插在什么地方

A君 - 2005-4-20 17:03:00

你给他们做个详细的制作步骤吧。

爱我的资格 - 2005-4-20 17:04:00

直接插在网页里方便

XdSSoft - 2005-4-20 17:15:00

那我做好标签给大家下载。嘿嘿。

sx-ljm - 2005-4-20 17:25:00

好东西，我早想要了

XdSSoft - 2005-4-20 17:36:00

已提供下载。

anana - 2005-4-20 17:45:00

???搞不明白 每个城市的天气都两样的啊

XdSSoft - 2005-4-20 17:47:00

是啊。所以作成标签咯。呵呵。

caizhi2 - 2005-5-18 11:07:00

哪里有下载的呀，找不到呀

3a3b3c - 2006-4-27 20:11:00

来晚了，没看见下载

qinzx - 2006-4-28 22:17:00

好的，收了

gelx - 2006-4-28 22:45:00

好东西，收藏起来。

qwerqwer - 2006-4-29 03:21:00

好东西哦！

小竣 - 2006-4-29 15:38:00

我来加精，A老大不要生气哦~

嘿嘿，楼主的劳动是值得赞扬的~！

binghuo - 2006-4-30 03:02:00

吼吼。。。

binghuo - 2006-4-30 03:02:00

吼吼。。。

捕快 - 2006-4-30 09:44:00

不错的插件啊。

追逐梦想 - 2006-5-1 01:31:00

不错

尚网网络 - 2006-5-1 22:44:00

多谢楼主

爱Ｓ你了

dxsdoor - 2006-5-22 22:51:00

不错，好东东

doudou888 - 2006-5-23 20:26:00

独立页面：

新建文件Weather.asp,把下列代码复制到Weather.asp文件中。调用这文件即可。

<%
CityStr="三明"
'Response.write "三明市<br>"&GetWeather("三明","")
Response.write CityStr&"市<br>"&GetWeather(CityStr,"")

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

%>

效果：比原作者的多了城市名

jackylhc - 2006-5-24 00:06:00

不错

linhuilh - 2006-5-24 17:23:00

过期了不能用了

12

查看完整版本: [原创]精品贈送：可结合风讯的城市天气预报标签函数。

Powered by Discuz!NT Archiver 2.0.1115 2001-2008 Comsenz Inc.