如何用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教程：