[会员中心]    [设为主页][加入收藏][发布文章]  [中文繁體]
电脑
软件
手机
软件
网站
源码
文章
资料
    文 章 搜 索
[选项]
    推 荐 文 章       More...
华硕易电脑(ASUS Eee PC 1025C)驱动程序(Windows XP)安装参考(图) 华硕易电脑(ASUS Eee PC 1025C..
  先来段开场白:为了外出携..
Acronis True Image 使用说明 Acronis True Image 使用说明
  一款可以在Windows下使用..
Norton Ghost 使用详解 Norton Ghost 使用详解
一、分区备份   使用Ghost..
Windows 2000/XP/2003 系统封装参考及工具 Windows 2000/XP/2003 系统封..
  一直以来,安装操作系统和..
    阅 读 排 行
Intel GMA 3600 V1.15 for Windows XP 驱动程序配置过程图解 Intel GMA 3600 V1.15 for Window..
Intel GMA 3600 V1.15 for Window..
夏普(SHARP) AR-1808S 以 A4 尺寸纸张扫描 夏普(SHARP) AR-1808S 以 A4 尺..
  新装的夏普(SHARP) AR-1808S..
中国电信的家庭宽带设置“端口映射”及获取公网IP地址 中国电信的家庭宽带设置“端口映..
  现在有些家庭/店铺安装了视..
路由器串联(路由器的分支再接一个路由器) 路由器串联(路由器的分支再接一..
  问题:路由器的分支再接一个..
XHTML 中 a 标签 target 属性失效的解决方法 XHTML 中 a 标签 target 属性失..
  在HTML 4.01/XHTML 1.0/XHTML..
19寸液晶显示器更换显卡后没有分辨率 1440*900 19寸液晶显示器更换显卡后没有分..
  宿舍的电脑更换显卡后,驱动..
申请/注销/关闭腾讯QQ空间 申请/注销/关闭腾讯QQ空间
  申请/注销/关闭腾讯QQ空间网..
电脑机箱(主板)前面板 USB 数据线的接线参考(图) 电脑机箱(主板)前面板 USB 数据..
  一、概述   因为每个 US..
  文 章 信 息
    xmlhttp 抓取网页内容
[留言][评论][收藏]
[文章分类:电脑系统/网络/网站设计/开发/优化][字体:隶体/楷体/宋体/黑体][字号:12px/14px/16px/18px][颜色:] 

<%
On Error Resume Next
Server.ScriptTimeOut=9999999
Function getHTTPPage(Path)
t = GetBody(Path)
getHTTPPage=BytesToBstr(t,"GB2312")
End function


Function bytes2BSTR(vIn)
strReturn = ""
For j = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,j,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,j+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
j = j + 1
End If
Next
bytes2BSTR = strReturn
End Function


Function GetBody(url)
on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP")

Retrieval.Open "Get", url, False, "", ""
Retrieval.Send
GetBody =Retrieval.responsebody

Set Retrieval = Nothing
End Function


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


%>


<%
Dim wstr,str,url,start,over,city
city = Request.QueryString("id")
url="http://cn.finance.yahoo.com/q?s=USDKRW=X&d=c"
wstr=getHTTPPage(url)
start=Newstring(wstr,"最後交易")
over=Newstring(wstr,"买方出价")
body=mid(wstr,start,over-start)


start2=Instr(body,"<b>")+3
over2=Instr(body,"</b>")
body2=mid(body,start2,over2-start2)


response.write body2
%>
抓取网页。偶要实现实实更新天气预报。利用了XMLHTTP组件,抓取网页的指定部分。
需要分件html源代码
此例中的被抓取的html源代码如下
<p align=left>2004年8月24日星期二;白天:晴有时多云南风3—4级;夜间:晴南风3—4级;气温:最高29℃最低19℃ </p>
而程序中是从
以2004年8月24日为关键字搜索,直到</p>结速
而抓取的内容就变成了"2004年8月24日星期二;白天:晴有时多云南风3—4级;夜间:晴南风3—4级;气温:最高29℃最低19℃ "
干干净净的了。记录一下。


<%
On Error Resume Next
Server.ScriptTimeOut=9999999
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


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
%>


<html>


<BODY bgColor=#ffffff leftMargin=0 topMargin=0 MARGINHEIGHT=0 MARGINWIDTH=0>
<!-- 开始 -->


<%
Dim wstr,str,url,start,over,dtime
dtime=Year(Date)&"年"&Month(Date)&"月"&Day(Date)&"日"
url="http://www.qianhuaweb.com/"
wstr=getHTTPPage(url)
start=Newstring(wstr,dtime)
over=Newstring(wstr,"</p>")
body=mid(wstr,start,over-start)


response.write "<MARQUEE onmouseover=this.stop(); onmouseout=this.start();>"&body&"</marquee>"

 

%>
<!-- 结束 -->
</body></html>


文章作者:未知  整理日期:2005-06-21
[文章浏览:][打印文章][发送文章]
相关文章
·XmlHttp对象及其方法 2005-06-21
·XmlHttp异步获取网站数据的例子 2005-06-21
阅读说明
·本站大部分文章转载于网络,如有侵权请留言告知,本站即做删除处理。
·本站法律法规类文章转载自[中国政府网(www.org.cn)],相关法律法规如有修订,请浏览[中国政府网]网站。
·本站转载的文章,不为其有效性,实效性,安全性,可用性等做保证。
·如果有什么问题,或者意见建议,请联系[网站管理员]
原“浪人文章”网站改名“老若尔文章站”,域名:article.lre.cn
本站使用【啊估文章站】网站系统    [联系网站管理员]         闽ICP备08009617号