繁體中文当前位置: 首页 > 图文教程 > 网络编程 > ASP > 从新浪提取上海天气的vbs
- ASP
- 飞云写的防CC攻击的ASP程序插件 打包下载
- 随机调用n条数据的方法分析
- 一个强健 实用的asp+ajax二级联动菜单(有演示和附源程序打包下载)
- asp 读取 utf-8格式文档并生成utf-8格式文档的乱码问题
- 实现纯真IP txt转mdb数据库的方法
- 用实现ASP批量删除目录及文件的代码
- [ASP]RegExp对象提供简单的正则表达式支持功能使用说明
- 用ASP生成UTF-8网页文件的两种方法
- asp利用fso给文件夹和文件改名的代码
- asp 采集实战代码
- 解决采集时出现msxml3.dll 错误的方法
- asp实现二进制字符串转换为Unicode字符串
- asp 用InStr查找特定字符串的代码
- [推荐]ASP编程通用函数收藏大全
- 去除HTML代码中所有标签的两种方法
- asp Chr 函数 数字转字母的方法
- asp快速开发方法之数据操作实例代码
- asp去除所有的超级链接的两种方法 替换与正则
- asp下实现截取字符串特定部分内容函数
- asp下取得客户端IP地址函数 转换IP地址函数
ASP 中的 从新浪提取上海天气的vbs
出处:互联网 整理: 软晨网（RuanChen.com） 发布: 2009-11-03 浏览: 132 ::
收藏到网摘: n/a
'文件：weather.vbs 放入计划任务，每天早上8:30执行，生成饱含
'文件供首页使用
'执行方式：cscript D:\上海国家会计学院网站\内部社区\vbs\weather.vbs
'********************************************************************************************************
' Symantec ScriptBlocking Authenticated File
' E9815BB2-5813-400B-9ED5-156350335DE3
const incFilePath = "D:\上海国家会计学院网站\内部社区\web\club\" '包含文件所在目录,最后的\号是必须的
const logfile = "d:\club-job-log.txt" '日志文件
const incWeather = "weather-report.asp" '包含文件所在目录,最后的\号是必须的
dim fs
dim f
on error resume next
Set fs = CreateObject("Scripting.FileSystemObject")
dim wstr
wstr=getHTTPPage("http://sh.sina.com.cn/")
'Response.Write wstr
if instr(wstr,"<img src="/upload/tech/20091103/20091103101756_8c235f89a8143a28a1d6067e959dd858.gif" width=172 height=17>")>0 then
wstr=mid(wstr,instr(wstr,"<img src="/upload/tech/20091103/20091103101756_8c235f89a8143a28a1d6067e959dd858.gif" width=172 height=17>")+len("<img src="/upload/tech/20091103/20091103101756_8c235f89a8143a28a1d6067e959dd858.gif" width=172 height=17>"))
wstr=mid(wstr,instr(wstr,"<table width=160 border=0 cellspacing=0 cellpadding=0>"))
wstr=mid(wstr,1,instr(wstr,"</table>")+len("</table>"))
end if
wstr=replace(wstr,"<tr><td colspan=3 align=right><a href=http://weather.sina.com.cn/>其他城市</a><font color=#015B7B>>></font></td></tr>","")
dim pos1,pos2
pos1=instr(wstr,"<tr>")
pos2=instr(pos1,wstr,"</tr>")
wstr=right(wstr,len(wstr)-pos2-4-4)
wstr=replace(wstr,"</table>","")
wstr=replace(wstr,"width=35","")
wstr=replace(wstr,"width=45","")
wstr=replace(wstr,"width=60","")
'Response.Write wstr
if err.number=0 then
Set f = fs.CreateTextFile(incFilePath & incWeather,true)
f.write wstr
set f = nothing
else
wscript.echo err.description
end if
set fs = nothing
Sub writeLog(Msg)
On Error Resume Next
Dim f
Set f = fs.OpenTextFile(logfile,8,true)
f.WriteLine now & " - " & Msg
f.close
End Sub
function getHTTPPage(url)
on error resume next
dim http
set http=createobject("MSXML2.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
'***********************************************
'
评论 (0) All
