xmlhttp 抓取网页内容_

文章·资料	电脑软件	手机软件	网站源码
电脑·手机·网络学习话题娱乐故事文化·历史国学典籍法律法规	操作系统网络办公·文件音频视频图形图像硬件·驱动程序行业学习编程游戏	安卓苹果鸿蒙其他	ASP ASP.NET JSP PHP HTML·CSS·JavaScript

本站搜索

推荐文章 More...


	华硕易电脑(ASUS Eee PC 10.. 先来段开场白：为了外出携带方便，..

	Acronis True Image 使用.. 　　一款可以在Windows下使用全..

	Norton Ghost 使用详解一、分区备份　　使用Ghost进..

文章阅读排行


	Microsoft SQL Server 2000.. 　　对于第一次安装 Microsoft SQ..

	ASP：Dimac W3 JMail 发送.. 【发送邮件测试代码下载】压..

	ASP：Persits ASPMail 发送.. 【发送邮件测试代码下载】压..

	VMware Workstation：安装.. 编写这份虚拟机安装的图文教程，..

	华硕易电脑(ASUS Eee PC 10.. 先来段开场白：为了外出携带方便，..

	ASP：Microsoft CDO 发送邮.. 【发送邮件测试代码下载】压..

文章信息

xmlhttp 抓取网页内容

〖评论()〗〖留言〗〖收藏〗

〖文章分类：电脑·手机·网络 / 网站设计·开发·优化〗〖阅读选项〗

<%
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,"")+3
over2=Instr(body,"")
body2=mid(body,start2,over2-start2)

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