从新浪提取上海天气的vbs

山里娃的后生

山里娃的后生

2016-01-29 17:38

从新浪提取上海天气的vbs,从新浪提取上海天气的vbs
  起始很简单的。分析一下抓下来的代码,然后处理一下就行了。


'文件:weather.vbs 放入计划任务,每天早上8:30执行,生成饱含
'文件供首页使用
'执行方式:cscript D:上海国家会计学院网站内部社区vbsweather.vbs
'********************************************************************************************************
' Symantec ScriptBlocking Authenticated File
' E9815BB2-5813-400B-9ED5-156350335DE3

const incFilePath = "D:上海国家会计学院网站内部社区webclub" '包含文件所在目录,最后的号是必须的
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="http://img.jcwcn.com/attachment/portal/jcwcj/2005-12/10/05121001075035847.gif" width=172 height=17")0 then
wstr=mid(wstr,instr(wstr,"<img src="http://img.jcwcn.com/attachment/portal/jcwcj/2005-12/10/05121001075035847.gif" width=172 height=17")+len("<img src="http://img.jcwcn.com/attachment/portal/jcwcj/2005-12/10/05121001075035847.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


'***********************************************
'

 
展开更多 50%)
分享

猜你喜欢

从新浪提取上海天气的vbs

ASP
从新浪提取上海天气的vbs

从新浪弄下来的全屏广告代码 与使用说明

Web开发
从新浪弄下来的全屏广告代码 与使用说明

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

run.vbs run2.vbs怎么清除

电脑入门
run.vbs run2.vbs怎么清除

vbs(asp)的栈类

ASP
vbs(asp)的栈类

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

新浪新闻小偷

Web开发
新浪新闻小偷

vbs类生成xml文件

Web开发
vbs类生成xml文件

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

PowerPointXP的界面与视图

PowerPointXP的界面与视图

重新应用Excel筛选和排序或清除筛选

重新应用Excel筛选和排序或清除筛选
下拉加载更多内容 ↓