<!--#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 " <font color=Green size=3pt>+</font>"&newsurl&"<br>"
else
response.write " <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 & " 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 & " 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,"<","<"),">",">")
str=Replace(Replace(Replace(replace(replace(str,chr(13),""),chr(10),""),"""","”"),"'","’")," ","")
FormatStr=str
Else
FormatStr=""
End if
End Function
新聞熱點
疑難解答
