论坛: 网站建设 标题: 刚刚完成的天气系统 复制本贴地址    
作者: NetFog [q70213526]    版主   登录
数据采自国家气象局..

演示地址 http://www.stustar.com/1/weather.asp

代码写得十分的乱.唉.是俺写过的比较乱的代码了,没什么规范

代码:

<%
dim tmp,CharaInfo,Img,MyCity,MyProvince
MyCity = "长沙"
MyProvince = "湖南"
tmp = GetRemoteData("http://www.cma.gov.cn/cma_new/tqyb/gn_city.php","city","province",MyCity,MyProvince)

CharaInfo = Replace(Replace(FormatStr(tmp,"<table border=0 cellpadding=0 cellspacing=0 width=280>","</table>"),"中央气象台",""),"<tr><td height=10></td></tr>","")
CharaInfo = ToArrayAndFormat(CharaInfo)

Img = Replace(Replace(FormatStr(tmp,"<table border=0 cellpadding=0 cellspacing=0>","</table>"),"/cma_new/tqyb/images/","http://www.cma.gov.cn/cma_new/tqyb/images/"),"<tr><td height=10></td></tr>","")
Img = "<table>" & Img & "</table>"

Function GetRemoteData(URL,pCity,pProvince,vCity,vProvince)
On Error Resume Next
Dim FullURL
FullURL = URL & "?" & pCity & "=" & vCity & "&" & pProvince & "=" & vProvince
Dim objXML,Result
Set objXML=Server.CreateObject("microsoft.xmlhttp")
objXML.open "get",FullURL,False
objXML.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objXML.send()
if err.number = 0 then
Result = objXML.ResponseBody
Result = BytesToBstr(Result,"GB2312")
else
Result = "Error"
end if
GetRemoteData = Result
End Function

Function FormatStr(vStr,HeadSplitTag,FootSplitTag)
Dim StartPos,EndPos,tmpResult
StartPos = InStr(vStr,HeadSplitTag)
tmpResult = Right(vStr,Len(vStr)-StartPos-Len(HeadSplitTag))
EndPos = InStr(tmpResult,FootSplitTag)
tmpResult = Left(tmpResult,EndPos-1)
FormatStr = tmpResult
End Function

Function ToArrayAndFormat(pStr)
Dim tmpArray
tmpArray = Split(pStr,"</font></td></tr>")
For i = 0 to Ubound(tmpArray)
tmpArray(i) = ClearHTMLCode(ClearCrLf(tmpArray(i)))
Next
ToArrayAndFormat = tmpArray
End Function

Function BytesToBstr(strBody,CodeBase)
dim objStream
set objStream = Server.CreateObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function

Function ClearCrLf(Str)
dim Tmp
Tmp = Replace(Str,Chr(9),"")
Tmp = Replace(Tmp,Chr(10),"")
Tmp = Replace(Tmp,Chr(13),"")
Tmp = Replace(Tmp,Chr(10)&Chr(13),"")
ClearCrLf = Tmp
End Function

Function ClearHTMLCode(originCode)
dim reg
set reg = new RegExp
reg.Pattern = "<[^>]*>"
reg.IgnoreCase = True
reg.Global = true
clearHTMLCode = reg.Replace(originCode, "")
End Function
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>天气查询</title>
<style type="text/css">
<!--
.bs {
border: 1px solid #FFFFFF;
}
.lb {
border-top-width: 1px;
border-right-width: 1px;
border-bottom-width: 1px;
border-left-width: 1px;
border-right-style: none;
border-left-style: solid;
border-top-color: #FFFFFF;
border-right-color: #FFFFFF;
border-bottom-color: #FFFFFF;
border-left-color: #FFFFFF;
}
.fb {
border-top-width: 1px;
border-right-width: 1px;
border-bottom-width: 1px;
border-left-width: 1px;
border-right-style: solid;
border-left-style: none;
border-top-color: #FFFFFF;
border-right-color: #FFFFFF;
border-bottom-color: #FFFFFF;
border-left-color: #FFFFFF;
}
td {
font-family: Arial, Helvetica, sans-serif;
font-size: 12px;
color: #000000;
}
body {
background-color: #EFECEC;
}
-->
</style>
</head>

<body>
<table width="220" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr>
    <td colspan="2" bgcolor="#E1DDDD" class="bs" height="23" align="center"><%=MyProvince%>&nbsp;<%=MyCity%>&nbsp;今日天气如下</td>
  </tr>
  <tr>
    <td width="61" bgcolor="#FFFFFF" class="lb"><div align="center"><%=Img%></div></td>
    <td width="189" bgcolor="#FFFFFF" class="fb"><div align="center">
<%
For i=0 to 2
Response.Write CharaInfo(i) & "<br>" & VBCRLF
Next
%></div></td>
  </tr>
 
  <tr>
    <td colspan="2" bgcolor="#E1DDDD" class="bs" height="23">&nbsp;</td>
  </tr>
</table>
</body>
</html>



地主 发表时间: 06-08-17 12:27

回复: NetFog [q70213526]   版主   登录
他丫的,才发现自己的空间不支持xmlhttp..只好用别人的了..

B1层 发表时间: 06-08-17 12:28

回复: amr [amr]   论坛用户   登录
好多代码

B2层 发表时间: 06-08-18 21:20

回复: NetFog [q70213526]   版主   登录
代码很少..没写注释..懒..

B3层 发表时间: 06-08-19 08:18

论坛: 网站建设

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon

粤ICP备05087286号