网络编程
每日更新|TOP排行榜|Tag标签|充值
网络编程教程模板无忧>建站教程>网络编程>Xml教程>
收藏分享查看评论Xml教程
大中小

如何用XMLHTTP对象抓取网页源代码，拆分数据写入数据库_Xml教程

编辑Tag赚U币
教程Tag：暂无Tag,欢迎添加,赚取U币!

推荐：XSL心得之制作图像超链接
这是我今天学习的时候遇到的另一个问题，做图像超链接要把链接地址放到a的href属性中去，可是这就是在标签中套标签，是不可以的，查了《Web编程实做教程》，才知道正确的解决方案，现在与大家分享。 此段代码运行需要两张图片：a.gif和b.gif。 my.xml 以下内

<!--#include file="fget.asp"-->
<!--#include file="conn.asp"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>dwww.cn 信息采集</title>
</head>
<body >
<%
Server.ScriptTimeOut=9999999
PageStart=""'抓取开始页
PageEnd=30'抓取结束页
lburl="http://www.tignet.cn/zhaoshang/index.asp?CurPageNum="'列表第一页开始url
pg=cint(request.querystring("pg"))'取得页数
'=========列表分页处理开始=========================
if PageStart="" and pg=0 then'判断是否为第一页
pg=1'第一页直接抓取
list_url="http://www.tignet.cn/zhaoshang/"
elseif PageStart="" and pg<>0 then'设置下一页抓取url
list_url=lburl&pg
elseif PageStart<>"" and pg=0 then
pg=PageStart'设置采集开始页数
list_url=lburl&pg
elseif PageStart<>"" and pg<>0 then
list_url=lburl&pg
end if
' response.Write list_url
' response.End()
'=========截取数据开始=============================
'第一步设置数据
lists="发布信息"'列表截取
listo="【中国虎网】 为医药界"
listxs="留言咨询"'循环链接截取
links="<a href='"'标题链接
linko="' target='_blank' >"
'=================内容加字段=======================
companys="<span style='font-size:12px;'>"'公司名称
companyo="</span>"
names="padding-bottom:3px;'>"'药品名称
nameo="</a>"
kinds=">类别："'药品类型
kindo="</span>"
times="更新时间："'代理商介绍
timeo="</span>"
Response.Write "</br>"
Response.Write "<center><font size=3pt>=============抓取"&list_url&"信息开始=============</font></center>"
'调用主题函数NewsList
Call NewsList()
'调用转向下一页函数
Call EndPage()
Function NewsList()'获取某类列表代码
strHtml=GetHTTPPage(list_url)'获得html代码
strHtml=strCut(strHtml,lists,listo,1)'获取列表代码
' response.Write strHtml
' response.End()
strHtml=split(strHtml,listxs)'拆分代码
' response.Write strHtml(1)
' response.End()
for i=0 to (ubound(strHtml)-1)'拆分标题，链接地址
newsurl="http://www.tignet.cn"&strCut(strHtml(i),links,linko,2)
' response.Write newsurl
' response.End()
'Get_time=FormatStr(Trim(strCut(strHtml(i),times,timeo,2)))'发布时间
' if FormatStr(strCut(strHtml(i),links,linko,2))<>"" then
' NewsHtml=GetHTTPPage(newsurl)'获取下一步详细内容页面html代码
'' response.Write NewsHtml
'' response.End()
' else
' response.Write "抓取第"&i&"条链接地址失败,不能抓取此项详细内容，程序将跳过此项目！"
' end if
'leibie=FormatStr(Trim(strCut(NewsHtml,kinds,kindo,2)))'采集产品类别
leibie=FormatStr(Trim(strCut(strHtml(i),kinds,kindo,2)))
if leibie<>"" then
company=FormatStr(Trim(strCut(strHtml(i),companys,companyo,2)))'采集公司名称
'ming=replace(FormatStr(Trim(strCut(strHtml(i),names,nameo,2))),"★","")'采集产品名称
ming=FormatStr(Trim(strCut(strHtml(i),names,nameo,2)))'采集产品名称
shijian=replace(FormatStr(Trim(strCut(strHtml(i),times,timeo,2))),"/","-")'发布时间
s1=instr(leibie,"品 ")
s2=len(leibie)
if s1>0 then
bigkind=mid(leibie,1,s1)
kind=mid(leibie,(s1+1),(s2-s1))
else
bigkind=leibie
kind=""
end if

if newsurl<>"" then
set rs=server.CreateObject("adodb.recordset")
sql="select url from Get_zhaoshang where url='"&newsurl&"'"
rs.open sql,conn,1,1
if rs.eof then
'插入数据
SQL="insert into Get_zhaoshang(company,names,bigkind,kind,url,times) values('"&company&"','"&ming&"','"&bigkind&"','"&kind&"','"&newsurl&"','"&shijian&"')"
Conn.execute(SQL)
response.write "&nbsp;&nbsp;&nbsp;<font color=Green size=3pt>+</font>"&newsurl&"<br>"
else
response.write "&nbsp;&nbsp;&nbsp;<font color=red size=3pt>此条信息已经存在，程序将跳过!</font><br>"
end if
end if
end if
Next
set strHtml=nothing
Response.Write "<center><font size=3pt>第"&pg&"页信息抓取结束！！！</font></center>"
End Function

Function GetHTTPPage(Url)'获取Html代码函数
err.clear
On Error Resume Next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
'HTTP的通信方式，比如GET或是POST '接收XML数据的服务器的URL地址。通常在URL中要指明ASP或CGI程序
'如果是异步通信方式(true)如果是同步方式(false)
Http.send()
'Send方法的参数类型是Variant，可以是字符串、DOM树或任意数据流。
'发送数据的方式分为同步和异步两种。在异步方式下，数据包一旦发送完毕，就结束Send进程，
'客户机执行其他的操作；而在同步方式下，客户机要等到服务器返回确认消息后才结束Send进程
if Http.readystate<>4 then
'0 　　Response对象已经创建，但XML文档上载过程尚未结束
'1 　　XML文档已经装载完毕
'2 　　XML文档已经装载完毕，正在处理中
'3 　　部分XML文档已经解析
'4 　　文档已经解析完毕，客户端可以接受返回消息

exit function
end if
GetHTTPPage = bytesToBSTR(Http.responseBody,"GB2312")'bytesToBSTR 编码转化函数
'=======对Http.responseBody的解释=========
'responseText：将返回消息作为文本字符串；
'responseBody：将返回消息作为HTML文档内容；
'responseXML：将返回消息视为XML文档，在服务器响应消息中含有XML数据时使用；
'responseStream：将返回消息视为Stream对象
'response.write GetHTTPPage
set http = Nothing
If Err Then
response.write err.description
Response.Write "<br><br><p align='center'><font color='red'><b>无法抓取本页面列表信息！！！</b></font></p>"
End If
End function

Function EndPage()'抓取下一页,跳转函数.PageNo--->抓取的页数
if pg<PageEnd Then'抓取下一页
response.write "<script>window.location='tignetcn.asp?pg="&pg+1&"';</script>"
else
Response.Write "<hr size=1 color=#00FF00 width=500>"
response.write "<center><font size=2pt><b>===============================信息抓取完毕!!!================================</b></font></center>"
response.end
end if
End Function
%>
</body>
</html>

下面是fget.asp里两个函数，一个是截取，一个事过滤html：
1：截取函数：


Function strCut(strContent,StartStr,EndStr,CutType)
'strContent 要截取的内容
'StartStr 开始标志字符
'EndStr 结束标志字符
'CutType 截取类型 1--包括开始，结尾标记 2----不包括开始，结尾标记

Dim strHtml,S1,S2
strHtml = strContent
On Error Resume Next
If CutType=2 Then'不包括开始，结尾标记
S1 = InStr(strHtml,StartStr)+Len(StartStr)
S2 = InStr(S1,strHtml,EndStr)

If Err Then
response.write "Unknow Wrong:"&err.description&"---BG:" & S1 & "&nbsp;End:"&S2&"<br>"
Err.Clear
strCut=""
Exit Function
Else
If S1>Len(StartStr) and S2>0 then
strCut=Mid(strHtml,S1,S2-S1)
Else
strCut=""
End If
End if
' response.Write strCut
' response.End()
Else'包括开始，结尾标记
S1 = InStr(strHtml,StartStr)
S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)
If Err Then
response.write "Unknow Wrong:"&err.description&"---BG:" & S1 & "&nbsp;End:"&S2&"<br>"
Err.Clear
strCut=""
Exit Function
Else
If S1>0 and S2>Len(EndStr) then
strCut=Mid(strHtml,S1,S2-S1)
Else
strCut=""
End If
End if
End If
End Function
2.html过滤函数，也过滤一些 回车，空格之类的

Function FormatStr(str)
Dim s1,s2
If str<>"" then
str=replace(replace(Trim(str),chr(32)&chr(32),""),chr(9),"")
DO While (instr(str,">")>0 and instr(str,"<")>0)
s1=InStr(str,"<")
s2=Instr(s1,str,">")
If s1>0 and s2>0 then
str=replace(str,mid(str,s1,s2-s1+1),"")
End if
Loop
str=replace(replace(str,"<","&lt;"),">","&gt;")
str=Replace(Replace(Replace(replace(replace(str,chr(13),""),chr(10),""),"""","”"),"'","’"),"&nbsp;","")
FormatStr=str
Else
FormatStr=""
End if
End Function
 

 

分享：详解XML语法概述
XML文档使用的是自描述的和简单的语法，一个XML文档最基本的构成包括：声明，处理指令（可选）和元素。以下是一个简单的XML文档： 1 ?XML version =1.0 encoding =GB2312 standalone=yes ? 2 ?XML-stylesheet type=text/xsl href=yxfqust.xsl ? 3

来源：模板无忧//所属分类：Xml教程/更新时间：2010-01-31
[收藏][报错][返回列表]
相关Xml教程：