VFP获得10天的天气预报

*--气象地址:http://xoap.weather.com （此地址当前信息1小时更新一次，10天信息2小时更新一次，感谢优快云用户mmadd3提供此地址，并对数据进行分析）。
*--在以上网页上方的Local weather后的文本框中输入要查询的城市（如：Beijing,China），出来页面后将鼠标移动到
*--Cities (1 of 1)
*--1. Beijing,China
*--中的Beijing,China上，即可得到北京的码：CHXX0008，哈尔滨的码：CHXX0046，用此方法可得到其他国家、地区
Local lcRemoteUrl,lcRemoteFile,lcLocalFile
If !File ('天气预报.dbf')
    Create Table 天气预报 (国家 C(20),地区 C(20),获取时间 C(5),更新时间1 T,日期 D,星期 C(6),经度 C(20),;
        纬度 C(20),时区 C(5),当前温度 C(5),感觉温度 C(5),当前天气 C(50),当前气图号 C(5),年均降雨量 C(50),;
        现在风速 C(5),现在风类 C(20),现在湿度 C(5),可见光强度 C(5),紫外线等级 C(5),紫外线强度 C(20),;
        更新时间2 T,最高温 C(5),最低温 C(5),太阳升起时 C(5),太阳下落时 C(5),白天气图号 C(5),白天天气 C(50),;
        白天风速 C(5),白天风类 C(20),白天降水率 C(5),白天湿度 C(5),夜晚气图号 C(5),夜晚天气 C(50),;
        夜晚风速 C(5),夜晚风类 C(20),夜晚降水率 C(5),夜晚湿度 C(5))
Endif
lcRemoteUrl="http://xoap.weather.com/weather/local/CHXX0008?cc=*&dayf=10&par=0&prod=xoap&key=0&unit=m" &&CHXX0008表示：北京
lcRemoteFile=lcRemoteUrl
lcLocalFile = "c:/weather.txt"
Declare Integer DeleteUrlCacheEntry In Wininet.Dll String szUrl
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller,String szURL,;
    String szFileName,Integer dwReserved,Integer lpfnCB
=DeleteUrlCacheEntry(lcRemoteUrl) &&清理缓存
If URLDownloadToFile(0,lcRemoteFile,lcLocalFile,0,0)<>0
    Messagebox ('读取数据失败！',48,'信息提示')
    Return
Endif
lcDateSet=Set ("Date")
Set Date To Mdy
lnDowSet=Set ("Fdow")
Set Fdow To
lnHours=Set ("Hours")
Set Hours To 24
lcMark=Set ("Mark")
Set Mark To
*只可惜VFP只识别VFP创建的XML，否则以下代码就可以不用这么麻烦了。
lcWeather=Filetostr ("c:/weather.txt")
Delete File "c:/weather.txt"
lcDnam="<"+Strextract (lcWeather,"<dnam>","</dnam>",1)+">"
lcCountry=Alltrim(Strextract(lcDnam,",",">"))     &&取得国家，具体哪个城市取决于上面网址
lcCity=Alltrim(Strextract(lcDnam,"<",","))        &&取得地区，具体哪个地区取决于上面网址
lcReadTime=Left(Ttoc(Ctot(Dtoc(Date())+Space(1)+Strextract(lcWeather,"<tm>","</tm>",1)),2),5) &&取得获取时间
ltUpdateTime1=Ctot(Strtran(Strextract(lcWeather,"<lsup>","</lsup>",1),'Local Time',''))       &&取得更新时间1
ltUpdateTime2=Ctot(Strtran(Strextract(lcWeather,"<lsup>","</lsup>",2),'Local Time',''))       &&取得更新时间2
ldDate=Ttod(ltUpdateTime2)                        &&取得第一天的日期
lcDow=Icase(Dow(ldDate)=1,'星期日',Dow(ldDate)=2,'星期一',Dow(ldDate)=3,'星期二',Dow (ldDate)=4,;
    '星期三',Dow(ldDate)=5,'星期四',Dow(ldDate)=6,'星期五',Dow(ldDate)=7,'星期六') &&取得第一天的星期
lcLat=Strextract(lcWeather,"<lat>","</lat>",1)    &&取得经度
lcLon=Strextract(lcWeather,"<lon>","</lon>",1)    &&取得纬度
lcZone=Strextract(lcWeather,"<zone>","</zone>",1) &&取得时区
lcTmp=Strextract(lcWeather,"<tmp>","</tmp>",1)    &&取得当前温度
lcFlik=Strextract(lcWeather,"<flik>","</flik>",1) &&取得感觉温度
lcTq=Strextract(lcWeather,"<t>","</t>",1)         &&取得当前天气
lcIcon=Strextract(lcWeather,"<icon>","</icon>",1) &&取得当前气图号
lcBar=Strtran(Strtran(Strextract(lcWeather,"<bar>","</bar>",1),Space(1),""),Chr(10),"") &&取得年均降雨量，个人认为这不是年均降雨量
lcFs=Strextract(lcWeather,"<s>","</s>",1)         &&取得现在风速
lcFl=Strextract(lcWeather,"<t>","</t>",2)         &&取得现在风类
lcHmid=Strextract(lcWeather,"<hmid>","</hmid>",1) &&取得现在湿度
lcVis=Strextract(lcWeather,"<vis>","</vis>",1)    &&取得可见光强度
lcZwxd=Strextract(lcWeather,"<i>","</i>",1)       &&取得紫外线等级
lcZwxq=Strextract(lcWeather,"<t>","</t>",3)       &&取得紫外线强度
If !Used ('天气预报')
    Use 天气预报
Endif
Select 天气预报
Locate For 日期=ldDate
If Found ()
    Update 天气预报 Set 国家=lcCountry,地区=lcCity,获取时间=lcReadTime,更新时间1=ltUpdateTime1,日期=ldDate,星期=lcDow,经度=lcLat,;
        纬度=lcLon,时区=lcZone,当前温度=lcTmp,感觉温度=lcFlik,当前天气=lcTq,当前气图号=lcIcon,年均降雨量=lcBar,;
        现在风速=lcFs,现在风类=lcFl,现在湿度=lcHmid,可见光强度=lcVis,紫外线等级=lcZwxd,紫外线强度=lcZwxq Where 日期=ldDate
Else
    Insert Into 天气预报 (国家,地区,获取时间,更新时间1,日期,星期,经度,纬度,时区,当前温度,感觉温度,当前天气,当前气图号,年均降雨量,;
        现在风速,现在风类,现在湿度,可见光强度,紫外线等级,紫外线强度) VALUES (lcCountry,lcCity,lcReadTime,ltUpdateTime1,ldDate,;
        lcDow,lcLat,lcLon,lcZone,lcTmp,lcFlik,lcTq,lcIcon,lcBar,lcFs,lcFl,lcHmid,lcVis,lcZwxd,lcZwxq)
Endif
For I=1 To 10
    lcHi=Strextract(lcWeather,"<hi>","</hi>",I)     &&取得最高温
    lcLow=Strextract(lcWeather,"<low>","</low>",I)  &&取得最低温
    lcSunr=Left(Ttoc(Ctot(Dtoc(Date())+Space(1)+Strextract(lcWeather,"<sunr>","</sunr>",I+1)),2),5) &&取得太阳升起时
    lcSuns=Left(Ttoc(Ctot(Dtoc(Date())+Space(1)+Strextract(lcWeather,"<suns>","</suns>",I+1)),2),5) &&取得太阳下落时
    lcPartD=Strextract (lcWeather,'<part p="d">',"</part>",I)
    lcIconD=Strextract(lcPartD,"<icon>","</icon>",1) &&取得白天气图号
    lcTqD=Strextract(lcPartD,"<t>","</t>",1)         &&取得白天天气
    lcFsD=Strextract(lcPartD,"<s>","</s>",1)         &&取得白天风速
    lcFlD=Strextract(lcPartD,"<t>","</t>",2)         &&取得白天风类
    lcPpcpD=Strextract(lcPartD,"<ppcp>","</ppcp>",1) &&取得白天降水率
    lcHmidD=Strextract(lcPartD,"<hmid>","</hmid>",1) &&取得白天湿度
    lcPartN=Strextract (lcWeather,'<part p="n">',"</part>",I)
    lcIconN=Strextract(lcPartN,"<icon>","</icon>",1) &&取得夜晚气图号
    lcTqN=Strextract(lcPartN,"<t>","</t>",1)         &&取得夜晚天气
    lcFsN=Strextract(lcPartN,"<s>","</s>",1)         &&取得夜晚风速
    lcFlN=Strextract(lcPartN,"<t>","</t>",2)         &&取得夜晚风类
    lcPpcpN=Strextract(lcPartN,"<ppcp>","</ppcp>",1) &&取得夜晚降水率
    lcHmidN=Strextract(lcPartN,"<hmid>","</hmid>",1) &&取得夜晚湿度
    ldDate2=ldDate+(I-1)                             &&日期
    lcDow=Icase(Dow(ldDate2)=1,'星期日',Dow(ldDate2)=2,'星期一',Dow(ldDate2)=3,'星期二',Dow (ldDate2)=4,'星期三',;
        Dow(ldDate2)=5,'星期四',Dow(ldDate2)=6,'星期五',Dow(ldDate2)=7,'星期六') &&取得星期
    Select 天气预报
    Locate For 日期=ldDate2
    If Found ()
        Update 天气预报 Set 国家=lcCountry,地区=lcCity,获取时间=lcReadTime,日期=ldDate2,星期=lcDow,经度=lcLat,纬度=lcLon,;
            时区=lcZone,更新时间2=ltUpdateTime2,最高温=lcHi,最低温=lcLow,太阳升起时=lcSunr,太阳下落时=lcSuns,白天气图号=lcIconD,;
            白天天气=lcTqD,白天风速=lcFsD,白天风类=lcFlD,白天降水率=lcPpcpD,白天湿度=lcHmidD,夜晚气图号=lcIconN,;
            夜晚天气=lcTqN,夜晚风速=lcFsN,夜晚风类=lcFlN,夜晚降水率=lcPpcpN,夜晚湿度=lcHmidN Where 日期=ldDate2
    Else
        Insert Into 天气预报 (国家,地区,获取时间,日期,星期,经度,纬度,时区,更新时间2,最高温,最低温,太阳升起时,太阳下落时,;
            白天气图号,白天天气,白天风速,白天风类,白天降水率,白天湿度,夜晚气图号,夜晚天气,夜晚风速,夜晚风类,夜晚降水率,夜晚湿度) ;
            VALUES (lcCountry,lcCity,lcReadTime,ldDate2,lcDow,lcLat,lcLon,lcZone,ltUpdateTime2,lcHi,lcLow,lcSunr,lcSuns,;
            lcIconD,lcTqD,lcFsD,lcFlD,lcPpcpD,lcHmidD,lcIconN,lcTqN,lcFsN,lcFlN,lcPpcpN,lcHmidN)
    Endif
Endfor
Clear Dlls
Set Date To (lcDateSet)
Set Fdow To (lnDowSet)
Set Hours To lnHours
Set Mark To lcMark
*USE IN '天气预报'
Browse &&看一下吧