今天闲来无事,刚好同事做的一个网站打开速度很慢,测试结果却是天气预报引起,于是一时兴起,打开了平时从不过问的天气预报窃取代码,细细品位,做了一些修改.希望以后的程序中能做的更好些:
代码如下:
---------------------------------------------------------------------------------------------------------------------
<%
dim sfile
sfile="tqyb.txt"
sfile=server.MapPath(sfile)
set fso=server.CreateObject("scripting.FileSystemObject")
if not fso.FileExists(sfile) then
tqyb=setweather()
call writetofile(tqyb,sfile)
else
set fsofile=fso.getfile(sfile)
lastdat=fsofile.DateLastModified '文件的最后日期
''
'' 因为有两次更新 6:00 和 17:30 so.....
if (hour(now())>=6 and hour(lastdat)>=18) or ( hour(now())>=17 and minute(now()) >=30 and hour(lastdat)<=17) then
tqyb=setweather()
call writetofile(tqyb,sfile)
end if
end if
sub writetofile(tqyb,sfile)
set fso=server.CreateObject("Scripting.FileSystemObject")
if fso.fileexists(sfile) then '存在文件先删除
fso.deletefile sfile
end if
set Fount=fso.CreateTextfile(sfile)
Fount.writeLine tqyb
Fount.close
set fso=nothing
end sub
Function getHTTPPage(Path)
t = GetBody(Path)
getHTTPPage=BytesToBstr(t,"GB2312")
End function
Function GetBody(url)
on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody = .ResponseBody
End With
Set Retrieval = Nothing
End Function
'然后调用XMLHTTP组件创建一个对象并进行初始化设置。
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
if Newstring<=0 then Newstring=Len(wstr)
End Function
function setweather()
Dim wstr,str,url
url="http://www.bl.gov.cn/news_read.php?id=7873&type=tq" '天气预报地址
wstr=getHTTPPage(url)
wstr=mid(wstr,instr(wstr,""))
wstr=mid(wstr,1,instr(10,wstr,"")+10)
wstr=html_down(wstr)
wstr=trim(wstr)
wstr="" & wstr & ""
setweather=wstr
end function
function html_down(str)
set re=new regexp
x="\<[^>]+()\>"
re.Pattern=x
re.global=true
re.ignoreCase=true
re.MultiLine=true
str=re.replace(str,"$1")
str=replace(str," ","")
html_down=str
end function
%>
-------------------------------------------------
有点美中不足的是,tqyb.txt是一定要存在的，不存在页面include检测就会出错,本来想继续读取txt文件然后write出来.偷懒啦.