可以自动更新的天气预报代码

最新推荐文章于 2017-04-19 23:07:02 发布

aloxy

最新推荐文章于 2017-04-19 23:07:02 发布

阅读量2.5k

点赞数

文章标签： stylesheet function javascript html url

本文链接：https://blog.csdn.net/aloxy/article/details/661205

版权

<html>
<head><title>兰州百科信息网--今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<LINK href="http://cn.yimg.com/i/cn/wea/cn_wea.css" type=text/css rel=STYLESHEET>

</head>
<BODY style="text-align:center ">
兰州百科信息网 <a href="/">首页</a><br>
今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京
<%
Function GetPageContent(Url)
Dim HTTPObj
On Error Resume Next
Set HTTPObj = Server.CreateObject("Microsoft.XMLHTTP")
With HTTPObj
  .Open "Get", Url, False, "", ""
  .Send
End With
if HTTPObj.Readystate <> 4 then
  Set HTTPObj = Nothing
  GetPageContent = False
  Exit Function
end if
GetPageContent = ResponseStrToStr(HTTPObj.ResponseBody)
Set HTTPObj = Nothing
End Function

Function ResponseStrToStr(BodyStr)
Dim ADOStreamObj
Set ADOStreamObj = Server.CreateObject("ADODB.Stream")
ADOStreamObj.Type = 1
ADOStreamObj.Mode = 3
ADOStreamObj.Open
ADOStreamObj.Write BodyStr
ADOStreamObj.Position = 0
ADOStreamObj.Type = 2
ADOStreamObj.Charset = "GB2312"
ResponseStrToStr = ADOStreamObj.ReadText
ADOStreamObj.Close
Set ADOStreamObj = Nothing
End Function

Function GetContent(Str,StartStr,LastStr,Flag)
Dim SearchIndex
On Error Resume Next
if Instr(LCase(Str),LCase(StartStr)) > 0 then
  Select Case Flag
   Case 0
    GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) - Len(StartStr) + 1)
    SearchIndex = Instr(LCase(GetContent),LCase(LastStr))
    if SearchIndex <= 0 then
     GetContent = ""
    else
     GetContent = Left(GetContent,SearchIndex - 1)
    end if
   Case 1
    GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) + 1)
    GetContent = Left(GetContent,Instr(LCase(GetContent),LCase(LastStr)) + Len(LastStr) - 1)
   Case 2
    GetContent = Right(Str,Len(Str) - Instr(lcase(Str),LCase(StartStr))-Len(StartStr) + 1)
   Case else
    GetContent = ""
  End Select
else
  GetContent = ""
end if
if Err.Number <> 0 then GetContent = ""
End Function

Sub SaveFile(Content,LocalFileName)
Dim AdodbStreamObj
Set AdodbStreamObj = Server.CreateObject("Adodb.Stream")
With AdodbStreamObj
  .Type = 2
  .Open
  .Charset = "GB2312"
  .WriteText Content
  .SaveToFile Server.MapPath(LocalFileName),2
  .Cancel()
  .Close()
End With
Set AdodbStreamObj = Nothing
End Sub
Sub FSOSaveFile(Content,LocalFileName)
Dim FileObj,FilePionter,sPath,ArrPath,TempPath,i
Set FileObj=Server.CreateObject("Scripting.FileSystemObject")
'Response.write Server.MapPath(LocalFileName)
sPath=replace(Server.MapPath(LocalFileName),"/","/")
ArrPath = Split(sPath,"/")
'TempPath = Server.MapPath("..")
TempPath = ArrPath(0)
for i=1 to UBound(ArrPath)-1
TempPath = TempPath & "/" & ArrPath(i)
'Response.write TempPath & "<br>"
if FileObj.FolderExists(TempPath)=false then FileObj.CreateFolder(TempPath)
next
Set FilePionter = FileObj.CreateTextFile(Server.MapPath(LocalFileName),True) '创建文件
FilePionter.Write Content
FilePionter.close     '释放对象
Set FilePionter = Nothing
Set FileObj = Nothing
End Sub
rFileName="tq.htm"
FileName=server.mappath("tq.htm")
Set fso=CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(FileName)
lastupdate=f.DateLastModified
set f=nothing
set fso=nothing
if DateDiff("d", Now, lastupdate)>0 or DateDiff("d", Now, lastupdate)<0 then
'if DateDiff("d", Now, lastupdate)=0   then
sUrl="http://weather.cn.yahoo.com/area.html?city=兰州"
contentStr= GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=西宁"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=乌鲁木齐"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=银川"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=拉萨"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=那曲"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=西安"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=北京"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=上海"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=深圳"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=广州"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=武汉"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=重庆"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=天津"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=济南"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=合肥"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)
sUrl="http://weather.cn.yahoo.com/area.html?city=南京"
contentStr=contentStr&GetContent(GetPageContent(sUrl),"","</div>",1)

cContent="<html>" & chr(13) & _
"<head><title>兰州百科信息网www.ailz.net--今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京</title>" & _
"<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & _
"<LINK href='http://cn.yimg.com/i/cn/wea/cn_wea.css' type=text/css rel=STYLESHEET>" & _
"</head>" & _
"<BODY style='text-align:center '><br>兰州百科信息网 <a href=http://www.ailz.net target=_self>首页</a><br>" & _
"今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京<br>" &contentStr &"<br>兰州百科信息网 <a href=http://www.ailz.net target=_self>首页</a><br>最后更新时间："&Now()&"，兰州百科信息网 www.ailz.net<script language='JavaScript' charset='gb2312' type='text/javascript' src='http://www1.itsun.com/count.php?uuid=1618206&style=icon'></script></body></html>"

   SaveFile cContent,rFileName
else
   'response.write cContent
   response.redirect "tq.htm"
end if
%><script language="JavaScript" charset="gb2312" type="text/javascript" src="http://www1.itsun.com/count.php?uuid=1618206&style=icon"></script></body>
</html>

aloxy

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
可以自动更新的天气预报代码

兰州百科信息网--今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京http://cn.yimg.com/i/cn/wea/cn_wea.css" type=text/css rel=STYLESHEET>兰州百科信息网首页今日天气-兰州西宁乌鲁木齐银川拉萨那曲西安北京上海深圳广州武汉重庆天津济南合肥南京Function GetPageContent(Url
复制链接

扫一扫