VBS获取网页内容

VBS获取网页内容
2011年03月14日
　　功能：通过VBS获取远程网页的内容，并提取其中需要的部分（示例中提取股票信息）
　　以下为代码:
　　
　　
　　
　　
　　测试VBS获取网页内容
　　
　　
　　
　　
　　
　　
　　//如果提示权限问题可以设置IE选项,修改所在区域的安全选项--其它--通过域访问数据源--启用
　　//如果不能创建对象是因为安装了 ADODB.Stream KB870669 补丁。
　　//修改注册表
　　//HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{00000566-0000-0010-8000-00AA006D2EA 4}
　　//把 Compatibility Flags 值改为 0 便可解决您的问题；
　　//把 Compatibility Flags 值改为 400 则可防止别人用此漏洞攻击您的系统。
　　//
　　url="http://stock.stockstar.com/report/data_ph.aspx"
　　pram="hidden_orderfield=DECLAREDATE&hidden_stockco de=&hidden_organcode=&hidden_ranking=&hidden_orderb y=desc&hidden_page="
　　on error resume next
　　strs = getStrFromURL(url,"post",pram & 0,0,0)
　　for x = 2 to 10
　　strs = strs & "|||||" & getStrFromURL(url,"post",pram & x,0,1)
　　next
　　//strs是取得页面的源代码,以|||||分隔,以下分别获取表格
　　arrSoucre=split(strs,"|||||")
　　soucreTable=""
　　for i = 0 to ubound(arrSoucre)
　　document.getElementById("div_msg").innerHTML=arrSo ucre(i)
　　//设置表格起始行,第一次有表头,以后不用取表头内容
　　if i = 0 then
　　stratRow = 0
　　else
　　stratRow = 2
　　end if
　　Set table=document.getElementsByTagName("table")(table Num)
　　n=table.rows.length
　　str=""
　　For r = stratRow To n-1
　　If table.rows(r).style.display"none" Then
　　soucreTable = soucreTable & table.rows(r).outerHTML
　　End if
　　Next
　　next
　　document.getElementById("div_msg").innerHTML="" & soucreTable & ""
　　function getStrFromURL(strUrl,Method,datas,tableNum,stratRo w) //参数:地址,方式,要提交的数据,第几个表格,表格起始行
　　dim objXmlHttp
　　set objXmlHttp = CreateObject("Microsoft.XMLHTTP")
　　objXmlHttp.open Method,strUrl,False
　　objXmlHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
　　objXmlHttp.send datas
　　if objXmlHttp.readystate4 then exit function
　　Dim binFileData
　　binFileData = objXmlHttp.responseBody
　　outStr=BytesToBstr(binFileData,"gb2312")
　　getStrFromURL=outStr
　　set objXmlHttp = nothing
　　end function
　　function BytesToBstr(body,code) //字节型转换为字符型
　　dim objstream
　　set objstream = CreateObject("adodb.stream")
　　objstream.Type = 1
　　objstream.Mode =3
　　objstream.Open
　　objstream.Write body
　　objstream.Position = 0
　　objstream.Type = 2
　　objstream.Charset =code
　　BytesToBstr = objstream.ReadText
　　objstream.Close
　　set objstream = nothing
　　end function
　　sub saveFile(str,file)
　　//ADODB.Stream 将执行结果保存到文件[FilePath] 中
　　Dim objAdoStream
　　set objAdoStream = CreateObject("ADODB.Stream")
　　objAdoStream.Type = 1
　　objAdoStream.Open()
　　objAdoStream.Write(binFileData)
　　objAdoStream.SaveToFile "c:\x.htm",2
　　objAdoStream.Close()
　　end sub