ASP的天气小偷

网站上放了个天气预报想给大家提供一点方便,TMD每天更新可郁闷死我了...用别人的吧风格有不合适,今天自己做了个天气小偷哈哈!

提供代码给大家参考

演示 http://www.hebut.net.cn

< %
修还下边URL为你需要的城市，具体ID到weather.com查询
url = " http://www.weathercn.com/f...

' 这里使用Application来存储获取的天气数据，每6小时获取一次数据，减轻服务器负担

' ===========判断更新缓存条件======
update = 0
' 默认为0，修改该值为1可立即更新缓存
if  Application( " date " ) = ""   or  Application( " time " ) = ""   then
update = 1
else
if  Application( " date " ) <> date   then ' 如果缓存内容不是当天则更新数据
update = 1
else
t1 = time ()
t3 = dateadd ( " h " , 6 ,Application( " time " )) ' 缓存内容超过6小时则更新数据
if  t1 > t3  then  update = 1
end   if
end   if
' ===========判断更新缓存条件=========

if  update = 1   then ' 是否更新

' 字符处理函数，用于过滤不必要的字符
function  check(x)
x = replace (x, " < " , "" )
x = replace (x, " > " , "" )
x = replace (x, chr ( 34 ), "" )
x = replace (x, " / " , " ~ " )
x = replace (x, " g " , "" )
x = replace (x, " e " , "" )
x = replace (x, " n " , "" )
x = replace (x, " t " , "" )
x = replace (x, " d " , "" )
check = x
end function

' 字符处理函数，用于过滤不必要的字符
function  checkpic(x)
x = replace (x, " image/icons/ " , "" )
x = replace (x, " mage/icons/ " , "" )
x = replace (x, " age/icons/ " , "" )
x = replace (x, " ge/icons/ " , "" )
x = replace (x, " e/icons/ " , "" )
x = replace (x, " /icons/ " , "" )
x = replace (x, " icons/ " , "" )
x = replace (x, " cons/ " , "" )
x = replace (x, " ons/ " , "" )
x = replace (x, " ns/ " , "" )
x = replace (x, " s/ " , "" )
x = replace (x, " / " , "" )
x = replace (x, " big " , " small " ) ' 原页面为大图，我用的小图，视自己情况更改
checkpic = x
end function

' 下边是关键，这个函数让ASP在服务器端访问指定页面并获取页面代码，保存在变量中
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  
     end   if  
    getHTTPPage = bytes2BSTR(Http.responseBody) 
     set  http = nothing
     if  err.number <> 0   then  err.Clear  
   end function

   Function  bytes2BSTR(vIn) 
     dim  strReturn 
     dim  i1,ThisCharCode,NextCharCode 
    strReturn  =   ""  
     For  i1  =   1   To  LenB(vIn) 
      ThisCharCode  =  AscB(MidB(vIn,i1, 1 )) 
       If  ThisCharCode  <   & H80  Then  
        strReturn  =  strReturn  &   Chr (ThisCharCode) 
       Else  
        NextCharCode  =  AscB(MidB(vIn,i1 + 1 , 1 )) 
        strReturn  =  strReturn  &   Chr ( CLng (ThisCharCode)  *   & H100  +  

CInt (NextCharCode)) 
        i1  =  i1  +   1  
       End   If  
     Next  
    bytes2BSTR  =  strReturn 
End Function


' 接下来从页面代码中分离出需要的数据
' 原理：每个项目选择一个关键词来确定需要的数据的位置，使用函数过滤掉无用内容
xxx = mid (getHTTPPage(url), 4700 )
xxx = left (xxx, 2500 )

zi = instr (xxx, " 紫外线强度： " )
zi = mid (xxx,zi + 6 , 2 )
zi = check(zi)

kong = instr (xxx, " 空气质量： " )
kong = mid (xxx,kong + 5 , 5 )
kong = check(kong)

wen = instr (xxx, " ℃ " )
wen = mid (xxx,wen - 8 , 8 )
wen = check(wen) & " ℃ "

feng = instr (xxx, " 风力 " )
feng = mid (xxx,feng + 2 , 5 )
feng = check(feng)

pic1 = instr (xxx, " big.gif " )
pic1 = mid (xxx,pic1 - 10 , 17 )
pic1 = checkpic(pic1)

pic2 = instrrev (xxx, " big.gif " )
pic2 = mid (xxx,pic2 - 10 , 17 )
pic2 = checkpic(pic2)
if  pic1 = pic2  then
pic = " <img src=http://www.weathercn.com/forecast/image/icons/ " & pic1 & " > "
else
pic = " <img src=http://www.weathercn.com/forecast/image/icons/ " & pic1 & " > - " & "  <img 

src = http: // www.weathercn.com / forecast / image / icons / " &pic2& " > "
end   if

' 数据写入缓存
Application( " date " ) = date
Application( " time " ) = time
Application( " zi " ) = zi
Application( " wen " ) = wen
Application( " feng " ) = feng
Application( " pic " ) = pic
Application( " kong " ) = kong

end   if

' 下面的变量可以在ASP程序中随意引用，灵活性100%  HOHO~~~
zi = Application( " zi " )
wen = Application( " wen " )
feng = Application( " feng " )
pic = Application( " pic " )
kong = Application( " kong " )
% >