asp根据访问者ip地址获取天气预报信息
根据访问用户IP地址自动获取天气预报下载中的asp版本代码的更新
原创文章,转载请注明出处:asp根据访问者ip地址获取天气预报信息
+展开
-HTML
<%@ language="vbscript" codepage="936"%>
<%
function RemoveHTML(str)
dim r:set r=new RegExp:r.ignorecase=true:r.global=true:r.pattern="<[^>]+>"
RemoveHTML=r.replace(str,"")
r.pattern="\s*"
RemoveHTML=r.replace(RemoveHTML,"")
set r=nothing
end function
function getip()
dim ip
ip =Request.ServerVariables("http_x_forwarded_for")
if ip="" then ip=Request.ServerVariables("remote_addr")
getip=ip
end function
function nowdate(d)
nowdate=year(d)&"-"&month(d)&"-"&day(d)
end function
Function BytesToBstr(strBody,CodeBase)
dim obj
set obj=Server.CreateObject("Adodb.Stream")
obj.Type=1
obj.Mode=3
obj.Open
obj.Write strBody
obj.Position=0
obj.Type=2
obj.Charset=CodeBase
BytesToBstr=obj.ReadText
obj.Close
set obj=nothing
End Function
function js(v)
js=replace(v,"'","\'")
end function
function getWeather()
dim ip,json,arr,ipnum,addr,xhr,htmlbody,r,mc,tmparr:json="var weather={success:false,err:'无法获取地址'};":addr=""
ip=getip()
if ip<>"" then
arr=split(ip,".")
ipnum=256*256*256*arr(0) + 256*256*arr(1) + 256*arr(2) +arr(3)'转换为数字
'===========================
dim cn,rs:set cn=server.createobject("adodb.connection")
cn.open "驱动字符串"
set rs=cn.execute("select addr from ipdb where ipe>=" & ipNum & " and ipb<=" & ipNum)
if not(rs.eof or rs.bof) then addr=rs(0)
rs.close:set rs=nothing:cn.close:set cn=nothing
if addr="" then addr="桂林"
'=========================
if addr<>"" then
Set xhr=Server.CreateObject("Microsoft.XMLHTTP")
xhr.open "get","http://php.weather.sina.com.cn/search.php?city="& addr,False
xhr.send
htmlbody=bytestobstr(xhr.responseBody,"gb2312")'获取返回的html内容,注意要使用gb2312来获取文本内容
Set xhr=Nothing
set r=new regexp:r.ignorecase=true:r.global=true
set dir=new regexp:dir.ignorecase=true:dir.global=true
set dsrx=new regexp:dsrx.ignorecase=true:dsrx.global=true
set tbrx=new regexp:tbrx.ignorecase=true:tbrx.global=true
set tdrx=new regexp:tdrx.ignorecase=true:tdrx.global=true
r.pattern=addr&",([^,]+),([^,]+),风力:([^']+)"
dir.pattern="<li>\s*风向:([^<]+)</li>"
dsrx.pattern="<div\s+class=""box_c\s*weather_date""\s*>([\s\S]+?)</div>"
tbrx.pattern="<table\s+class=""cell""[^>]*>([\s\S]+?)</table>"
tdrx.pattern="<td>([\s\S]+?)</td>"
if r.test(htmlbody) then
dim dt:dt=now
set m=r.execute(htmlbody)
set dirm=dir.execute(htmlbody)
json="{success:true,addr:'" &js(addr) & "',weathers:[{d:'" + nowdate(dt)& "'"&_
",weather:'" & m.item(0).submatches(0) & "',tmp:'" & m.item(0).submatches(1) & "',dir:'" & dirm.item(0).submatches(0) & "',strong:'" & m.item(0).submatches(2) & "'}"
if dsrx.test(htmlbody) then
set m=dsrx.execute(htmlbody)
htmlbody=m.item(0).submatches(0)
set mc=tbrx.execute(htmlbody)
dim mctd,dweather,nweather,dtmp,ntmp,ndir,ddir,idx
if mc.count>1 then
idx=mc.count
for i=0 to idx
set mctd=tdrx.execute(mc.item(i).submatches(0))
dweather=mctd.item(4).submatches(0):nweather=mctd.item(5).submatches(0)
if dweather<>nweather then dweather=dweather & " 转 " & nweather
dtmp = RemoveHTML(mctd.item(6).submatches(0)):ntmp = RemoveHTML(mctd.item(7).submatches(0))
ddir =mctd.item(8).submatches(0):ndir = mctd.item(9).submatches(0)
if ddir <> ndir then ddir = ddir & " 转 " & ndir
dt = dateadd("d",1,dt)
json =json& ",{d:'" &nowdate(dt)& "',weather:'" & dweather & "',tmp:'" & dtmp & "~" & ntmp & "',dir:'" & ddir & "'}"
next
end if
end if
json =json& "]};"
end if
end if
end if
getWeather=json
end function
response.charset="gb2312"
response.write getWeather()
%>
<%
function RemoveHTML(str)
dim r:set r=new RegExp:r.ignorecase=true:r.global=true:r.pattern="<[^>]+>"
RemoveHTML=r.replace(str,"")
r.pattern="\s*"
RemoveHTML=r.replace(RemoveHTML,"")
set r=nothing
end function
function getip()
dim ip
ip =Request.ServerVariables("http_x_forwarded_for")
if ip="" then ip=Request.ServerVariables("remote_addr")
getip=ip
end function
function nowdate(d)
nowdate=year(d)&"-"&month(d)&"-"&day(d)
end function
Function BytesToBstr(strBody,CodeBase)
dim obj
set obj=Server.CreateObject("Adodb.Stream")
obj.Type=1
obj.Mode=3
obj.Open
obj.Write strBody
obj.Position=0
obj.Type=2
obj.Charset=CodeBase
BytesToBstr=obj.ReadText
obj.Close
set obj=nothing
End Function
function js(v)
js=replace(v,"'","\'")
end function
function getWeather()
dim ip,json,arr,ipnum,addr,xhr,htmlbody,r,mc,tmparr:json="var weather={success:false,err:'无法获取地址'};":addr=""
ip=getip()
if ip<>"" then
arr=split(ip,".")
ipnum=256*256*256*arr(0) + 256*256*arr(1) + 256*arr(2) +arr(3)'转换为数字
'===========================
dim cn,rs:set cn=server.createobject("adodb.connection")
cn.open "驱动字符串"
set rs=cn.execute("select addr from ipdb where ipe>=" & ipNum & " and ipb<=" & ipNum)
if not(rs.eof or rs.bof) then addr=rs(0)
rs.close:set rs=nothing:cn.close:set cn=nothing
if addr="" then addr="桂林"
'=========================
if addr<>"" then
Set xhr=Server.CreateObject("Microsoft.XMLHTTP")
xhr.open "get","http://php.weather.sina.com.cn/search.php?city="& addr,False
xhr.send
htmlbody=bytestobstr(xhr.responseBody,"gb2312")'获取返回的html内容,注意要使用gb2312来获取文本内容
Set xhr=Nothing
set r=new regexp:r.ignorecase=true:r.global=true
set dir=new regexp:dir.ignorecase=true:dir.global=true
set dsrx=new regexp:dsrx.ignorecase=true:dsrx.global=true
set tbrx=new regexp:tbrx.ignorecase=true:tbrx.global=true
set tdrx=new regexp:tdrx.ignorecase=true:tdrx.global=true
r.pattern=addr&",([^,]+),([^,]+),风力:([^']+)"
dir.pattern="<li>\s*风向:([^<]+)</li>"
dsrx.pattern="<div\s+class=""box_c\s*weather_date""\s*>([\s\S]+?)</div>"
tbrx.pattern="<table\s+class=""cell""[^>]*>([\s\S]+?)</table>"
tdrx.pattern="<td>([\s\S]+?)</td>"
if r.test(htmlbody) then
dim dt:dt=now
set m=r.execute(htmlbody)
set dirm=dir.execute(htmlbody)
json="{success:true,addr:'" &js(addr) & "',weathers:[{d:'" + nowdate(dt)& "'"&_
",weather:'" & m.item(0).submatches(0) & "',tmp:'" & m.item(0).submatches(1) & "',dir:'" & dirm.item(0).submatches(0) & "',strong:'" & m.item(0).submatches(2) & "'}"
if dsrx.test(htmlbody) then
set m=dsrx.execute(htmlbody)
htmlbody=m.item(0).submatches(0)
set mc=tbrx.execute(htmlbody)
dim mctd,dweather,nweather,dtmp,ntmp,ndir,ddir,idx
if mc.count>1 then
idx=mc.count
for i=0 to idx
set mctd=tdrx.execute(mc.item(i).submatches(0))
dweather=mctd.item(4).submatches(0):nweather=mctd.item(5).submatches(0)
if dweather<>nweather then dweather=dweather & " 转 " & nweather
dtmp = RemoveHTML(mctd.item(6).submatches(0)):ntmp = RemoveHTML(mctd.item(7).submatches(0))
ddir =mctd.item(8).submatches(0):ndir = mctd.item(9).submatches(0)
if ddir <> ndir then ddir = ddir & " 转 " & ndir
dt = dateadd("d",1,dt)
json =json& ",{d:'" &nowdate(dt)& "',weather:'" & dweather & "',tmp:'" & dtmp & "~" & ntmp & "',dir:'" & ddir & "'}"
next
end if
end if
json =json& "]};"
end if
end if
end if
getWeather=json
end function
response.charset="gb2312"
response.write getWeather()
%>
加支付宝好友偷能量挖...
原创文章,转载请注明出处:asp根据访问者ip地址获取天气预报信息