[原创]精品贈送：可结合风讯的城市天气预报标签函数。

个人空间 相册
组别:新手上路
性别:
生日:1900-1-1
来自:
积分:64
帖子:53
注册: 2005-01-24

2005-04-20 16:40 | 只看楼主

树型| 收藏| 小中大 1

效果：

天气:多云
温度: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&"市 ","'); return true;",0)
case "Sohu"
GetWeather=GetContent(TakenHTML,"城市:"&CityStr&"",""">",0)
case else
GetWeather=GetContent(TakenHTML,"drawcitys(' 城市:"&CityStr&"市 ","'); 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 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 16:41 \| 只看楼主树型\| 收藏\| 小中大 2 嘿嘿。我要精华和金币。吼吼。。。

A君首席设计师个人空间相册组别:贵宾性别: 生日:1981-7-19 来自: 积分:1273 帖子:931 注册: 2004-03-02	2005-04-20 16:42 \| 树型\| 收藏\| 小中大 3 效果，效果，。。。。看到效果就给你加做人要厚道，做站要低调。

XdSSoft 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 16:43 \| 只看楼主树型\| 收藏\| 小中大 4 风讯研究室QQ群：2202324 汗。。。。

网路游侠个人空间相册组别:高级会员性别: 生日:1900-1-1 来自: 积分:1142 帖子:993 注册: 2003-12-28	2005-04-20 16:46 \| 树型\| 收藏\| 小中大 5 很好行货

爱我的资格个人空间相册组别:注册会员性别: 生日:1900-1-1 来自: 积分:242 帖子:231 注册: 2004-11-01	2005-04-20 16:46 \| 树型\| 收藏\| 小中大 6 呵呵，我已经试过了，拿来就能用，直接执行就可以了

XdSSoft 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 16:53 \| 只看楼主树型\| 收藏\| 小中大 7 [推荐]这个网站是用2。0做的很好进去看看呵呵。。本来就是嘛。存为ASP文件就能用了。自已改成标签就行了。 [此贴子已经被作者于2005-4-20 16:57:10编辑过]

lukyvivi 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:336 帖子:48 注册: 2005-04-18	2005-04-20 17:00 \| 树型\| 收藏\| 小中大 8 你应该说的详细一些,要不然很多人可能一头雾水呀.比如,插在什么地方

A君首席设计师个人空间相册组别:贵宾性别: 生日:1981-7-19 来自: 积分:1273 帖子:931 注册: 2004-03-02	2005-04-20 17:03 \| 树型\| 收藏\| 小中大 9 你给他们做个详细的制作步骤吧。做人要厚道，做站要低调。

爱我的资格个人空间相册组别:注册会员性别: 生日:1900-1-1 来自: 积分:242 帖子:231 注册: 2004-11-01	2005-04-20 17:04 \| 树型\| 收藏\| 小中大 10 直接插在网页里方便

XdSSoft 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 17:15 \| 只看楼主树型\| 收藏\| 小中大 11 那我做好标签给大家下载。嘿嘿。

sx-ljm 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:2108 帖子:321 注册: 2005-02-27	2005-04-20 17:25 \| 树型\| 收藏\| 小中大 12 请哪位老大推荐一个有很强会员功能的CMS 好东西，我早想要了

XdSSoft 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 17:36 \| 只看楼主树型\| 收藏\| 小中大 13 已提供下载。

anana 个人空间相册组别:注册会员性别: 生日:1900-1-1 来自: 积分:159 帖子:124 注册: 2005-01-20	2005-04-20 17:45 \| 树型\| 收藏\| 小中大 14 ???搞不明白每个城市的天气都两样的啊

XdSSoft 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:64 帖子:53 注册: 2005-01-24	2005-04-20 17:47 \| 只看楼主树型\| 收藏\| 小中大 15 是啊。所以作成标签咯。呵呵。

caizhi2 个人空间相册组别:注册会员性别: 生日:1900-1-1 来自: 积分:256 帖子:226 注册: 2004-06-14	2005-05-18 11:07 \| 树型\| 收藏\| 小中大 16 哪里有下载的呀，找不到呀

3a3b3c 个人空间相册组别:游客性别: 来自: 积分:0 帖子:0 注册:	2006-04-27 20:11 \| 树型\| 收藏\| 小中大 17 来晚了，没看见下载

qinzx 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:40 帖子:11 注册: 2006-03-08	2006-04-28 22:17 \| 树型\| 收藏\| 小中大 18 好的，收了

gelx 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:257 帖子:11 注册: 2005-08-16	2006-04-28 22:45 \| 树型\| 收藏\| 小中大 19 好东西，收藏起来。

qwerqwer 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:202 帖子:34 注册: 2004-05-14	2006-04-29 03:21 \| 树型\| 收藏\| 小中大 20 好东西哦！

小竣个人空间相册组别:贵宾性别: 生日:1986-6-3 来自: 积分:797 帖子:682 注册: 2005-01-12	2006-04-29 15:38 \| 树型\| 收藏\| 小中大 21 我来加精，A老大不要生气哦~ 嘿嘿，楼主的劳动是值得赞扬的~！ Foosun交流群 10792070 1883612 ！ PS ： FS4.0....万众期待的你何时长大？

binghuo 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:79 帖子:14 注册: 2006-02-15	2006-04-30 03:02 \| 树型\| 收藏\| 小中大 22 吼吼。。。

binghuo 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:79 帖子:14 注册: 2006-02-15	2006-04-30 03:02 \| 树型\| 收藏\| 小中大 23 吼吼。。。

捕快个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:230 帖子:10 注册: 2004-08-24	2006-04-30 09:44 \| 树型\| 收藏\| 小中大 24 不错的插件啊。

追逐梦想个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:118 帖子:10 注册: 2005-09-16	2006-05-01 01:31 \| 树型\| 收藏\| 小中大 25 不错

尚网网络个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:78 帖子:17 注册: 2006-02-24	2006-05-01 22:44 \| 树型\| 收藏\| 小中大 26 多谢楼主爱Ｓ你了

dxsdoor 个人空间相册组别:新手上路性别: 生日:1900-1-1 来自: 积分:89 帖子:3 注册: 2005-04-10	2006-05-22 22:51 \| 树型\| 收藏\| 小中大 27 不错，好东东

个人空间 相册
组别:贵宾
性别:
生日:1900-1-1
来自:
积分:1397
帖子:1293
注册: 2005-03-07

2006-05-23 20:26 |

树型| 收藏| 小中大 28

独立页面：

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

<%
CityStr="三明"
'Response.write "三明市 "&GetWeather("三明","")
Response.write CityStr&"市 "&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&"市 ","'); return true;",0)
case "Sohu"
GetWeather=GetContent(TakenHTML,"城市:"&CityStr&"",""">",0)
case else
GetWeather=GetContent(TakenHTML,"drawcitys(' 城市:"&CityStr&"市 ","'); 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

%>

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

福建宁化第二中学网站(调试中)：
http://www.nhez.cn （风讯核心，调试中）
QQ:280601330
￥已转到免费1G空间，欢迎光临。￥
免费1G空间注册地址：
http://www.m

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

标题: [原创]精品贈送：可结合风讯的城市天气预报标签函数。