| |
 |
|
 |
 |
|
 |
一个内网代理天气预报程序
|
|
|
需求：公司内网安全用户无法访问外部网。但要求，能查看天气预报信息。
说明：其实简单的方法也有，那就是有一个人每天到外部网去查询天气预报信息，然后更新到内部OA邮件或内部网络上。但这样势必烦琐不及时。下面给出一个用ASP实现的代理程序，可以让不能访问互联网的内部用户访问到需要的信息。
配置：一台内网可访问到的服务器、服务器可访问互联网。
原理： 我们这里使用的是121的天气预报页面，搜现我们找到需要的天气预报预定页面，在服务器上将页面读取到服务器缓存，然后对缓存数据做适当处理。处理完成后反馈给内部请求用户。
Asp代码：
|
<BODY bgColor=#9d9d9d leftMargin=0 topMargin=0 rightMargin=0>
<TABLE width="100%" height="200" border=0 cellPadding=3 cellSpacing=1>
<TBODY>
<TR>
<TD width="100%" class=row1>
<%
dim url,wstr,addr,timeadd,wstr1,wstr2,wstr_print
Server.ScriptTimeOut=60
url="http://weather.tq121.com.cn/detail.php?city=%BB%DD%D6%DD&submit=%B3%C7%CA%D0%CB%D1%CB%F7"
wstr=getHTTPPage(url)
if err.number=0 then
''''''''''''''''''''''''''''''''''''''需要实现将信息中地址从新定向，志向完整URL的也就是带
''''''HTTP：//或www的联结改为proxy.asp?'url=完整地址，如果是相对地址，改成proxy.asp?url=
if wstr="" then
wstr="未取到数据"
else
wstr = Replace(wstr, "../images/","images/")
str=split(wstr,"</table>")
for i=15 to Ubound(str)-7
'********************测试代码********************
'Response.Write str(i)&+"</table>"
'Response.Write "--"&+i&+"--"
wstr_print= wstr_print&+str(i)&+"</table>"
Next
' wstr_print=raplace(wstr_print,"<img","<b")
' for i=15 to 86
' wstr= wstr&+str(i)
' Next
' wstr=str(15)&+str(16)&+str(17)&+str(18)&+str(19)&+str(20)&+str(21)&+str(22)&+str(23)&+str(24)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''重写成功'''''''''
|
这样就实现了内网用户自动查看天气预报的功能，阅读代码会发现，数据中对图片路径做了处理，因为从站点取回来是超文本数据不包括图片信息，我们可以将图片下载到站点的指定的目录中即可。
实际测试发现这段代码的执行是比较缓慢的，而且占用一定的服务器资源。如果请求用户过多或过频繁势必会出一些问题，但幸好我的内网还承受的了。
如果真的是有多人请求怎么办，其实也很简单。
我们只需要简单对代码进行修改即可，但前提是IUSER用户必须对目录具有写权限。
思路：因为天气预报为每天一次更新的内容，所以我们可以让每天第一个访问的用户触发天气访问事件。然后将天气信息更新到服务器文件或数据库，此处我们更新到数据库。
ASP完整代码：
|
<!--#include file="conn.asp"-->
<%
dim wstr_print
now_date=year(now)&+"-"&+month(now)&+"-"&+day(now)
set rs=Server.CreateObject("ADODB.Recordset")
sql="select * from weather where id=1 "
rs.open sql,conn,1,3
if rs.bof and rs.eof then ' 未启用过天气数据
rs("today_tianqi")="第二天开始启用天气数据"
rs("date")=now_date
rs.update() '更新到数据库
rs.close
else
if cdate(rs("date"))<cdate(now_date) then
call htmlread() '读取天气信息
rs("today_tianqi")=wstr_data
rs("date")=now_date
rs.update() '更新到数据库
rs.close
wstr_print=wstr_data&+"测试一" '更新到页面
else
wstr_print=rs("today_tianqi")&+"测试二" '更新到页面
end if
end if
sub htmlread()
dim url,wstr,addr,timeadd,wstr_data
Server.ScriptTimeOut=60
url="http://weather.tq121.com.cn/detail.php?city=%BB%DD%D6%DD&submit=%B3%C7%CA%D0%CB%D1%CB%F7"
wstr=getHTTPPage(url)
if err.number=0 then
''''''''''''''''''''''''''''''''''''''需要实现将信息中地址从新定向，志向完整URL的也就是带
''''''HTTP：//或www的联结改为proxy.asp?'url=完整地址，如果是相对地址，改成proxy.asp?url=
if wstr="" then
wstr="未取到数据"
else
wstr = Replace(wstr, "../images/","images/")
str=split(wstr,"</table>")
for i=15 to Ubound(str)-7
'Response.Write str(i)&+"</table>" '测试数据
'Response.Write "--"&+i&+"--" '测试数据
wstr_data= wstr_print&+str(i)&+"</table>"
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''重写成功''''''''''
end if
else
wscript.echo err.description
end if
end sub
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 i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
%>
<BODY bgColor=#9d9d9d leftMargin=0 topMargin=0 rightMargin=0>
<TABLE width="100%" height="200" border=0 cellPadding=3 cellSpacing=1>
<TBODY>
<TR>
<TD width="100%" class=row1>
<table width="790" height="104" border="0" align="center" cellpadding="0" cellspacing="0" bgcolor="#FFFFFF">
<tr>
<td width="790" valign="top" bgcolor="#FFFFFF">
<font color=red>您目前是通过Sic接口访问的中央台天气频道，欢迎使用本程序</font><a
href="http://weather.tq121.com.cn/detail.php?city=%BB%DD%D6%DD&submit=%B3%C7%CA%D0%CB%D1%CB%F7">能够连接互连网的人可以点击
访问问天网查询更多天气信息</a> <br>
由于此连接是服务器捕获访问，需要服务器大负荷处理数据，请不要频繁刷新此页面，我们将对每次查询的用户做日志记录。
<br><img src=../index.files/index-2.gif width="100%">
</td></tr>
<tr>
<td width="790" valign="top" bgcolor="#FFFFFF">
<%=wstr_print%>
</td></tr></table>
</bofy>
</html>
|
|
|
|
发表于： 2008-01-03，修改于： 2008-01-03 10:55，已浏览434次，有评论2条
推荐
投诉
|
|
 |
|
 |
|  |
|
 |
|
|
|
网友评论
|
|
|
 |
网友：
ztfstar
| 时间：2008-01-04 17:25:49 IP地址：59.33.249.★ |
|
|
|
实测过程中发现一个问题，那就是站点天气的实际更新时间为早上6点。如果6点之前有人点击更新了页面那当天天气将不能得到更新。遇到问题后对代码进行略微调整。
dim wstr_print,q_time
q_time="06:00:00"
now_date=year(now)&+"-"&+month(now)&+"-"&+day(now)
set rs=Server.CreateObject("ADODB.Recordset")
sql="select * from weather where id=1 "
rs.open sql,conn,1,3
if rs.bof and rs.eof then ' 未启用过天气数据
rs("today_tianqi")="第二天开始启用天气数据"
rs("date")=now_date
rs.update() '更新到数据库
rs.close
else
if cdate(rs("date"))<cdate(now_date) and cdate(now())>cdate(q_time) then
这样就判断了在6点之后才更新当前数据，使 程序更加完善。
|
|
|
|
|
|
|
|
|
|
|
网友：
本站网友 | 时间：2008-06-13 11:08:36 IP地址：61.142.179.★ |
|
|
|
<a href="http://www.bxcsb.com/pr.asp">超声波</a>
<a href="http://www.a8woool.com/pr.asp">净化工程</a>
<a href="http://www.kamson.cn/pr.asp">超声波清洗机</a>
|
|
|
|
|
|
|
| |
|
|
|
