数据采自国家气象局..
演示地址
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%> <%=MyCity%> 今日天气如下</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"> </td>
</tr>
</table>
</body>
</html>
|
版主
论坛用户
论坛: 网站建设
标题: 刚刚完成的天气系统