XMLHTTP批量抓取遠程資料

最後更新：2018-12-08 來源：互聯網

上載者：User

創建阿里雲帳戶，並獲得超過 40 款產品的免費試用版；而企業帳戶則可以享有總值 $1200 的免費試用版。立即註冊！

可以在此基礎上結合Regex做成更好的效果，希望大家能分享一下Xmlhttp的session共用技術

<html>
<head>
<title>AUTOGET</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<body bgcolor="#FFFFFF" style="font-family:Arial;font-size:12px">
<%
'=================================================
'FileName: Getit.Asp
'Intro : Auto Get Data From Remote WebSite
'Author: Babyt(阿泰)
'URL: http://blog.csdn.net/babyt
'createAt: 2002-02 Lastupdate:2004-09
'DB Table : data
'Table Field:
' UID -> Long -> Keep ID Of the pages
' UContent -> Text -> Keep Content Of the Pages(HTML)
'=================================================

Server.ScriptTimeout=5000

'on error resume next
Set conn = Server.createObject("ADODB.Connection")
conn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("getit.mdb")
Set rs = Server.createObject("ADODB.Recordset")
sql="select * from data"
rs.open sql,conn,1,3

Dim comeFrom,myErr,myCount

'========================================================
comeFrom="http://www.xxx.com/U.asp?ID="
myErr1="該資料不存在"
myErr2="該資料已隱藏"
'========================================================

'***************************************************************
' 只需要更改這裡 i 的始點intMin和終點intMax,設定步長intStep
' 每次區間設定成5萬左右。估計要兩個多小時。期間不需要人工幹預
'****************************************************************
intMin=0
intMax=10000
'設定步長
intStep=100

'==========================================================
'以下代碼不要更改
'==========================================================
Call GetPart (intMin)
Response.write "已經轉換完成" & intMin & "~~" & intMax & "之間的資料"
rs.close
Set rs=Nothing
conn.Close
set conn=nothing
%>
</body>
</html>
<%
'使用XMLHTTP抓取地址並進次內容處理
Function GetBody(Url)
Dim objXML
On Error Resume Next
Set objXML = createObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
GetBody = .ResponseBody
End With
GetBody=BytesToBstr(GetBody,"GB2312")
Set objXML = Nothing
End Function
'使用Adodb.Stream處理位元據
Function BytesToBstr(strBody,CodeBase)
dim objStream
set objStream = Server.createObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function
'主函數
Function GetPart(iStart)
Dim iGo
time1=timer()
myCount=0
For iGo=iStart To iStart+intStep
If iGo<=intMax Then
Response.Execute comeFrom & iGo
'進行簡單的資料處理
content = GetBody(comeFrom & iGo )
content = Replace(content,chr(34),""")
If instr(content,myErr1) OR instr(content,myErr2) Then
'跳過錯誤資訊
Else
'寫入資料庫
rs.AddNew
rs("UID")=iGo
'********************************
rs("UContent")=Replace(content,""",chr(34))
'*********************************
rs.update
myCount=myCount+1
Response.Write iGo & " "
Response.Flush
End If
Else
Response.write "成功抓取"&myCount&"條記錄,"
time2=timer()
Response.write "耗時:" & Int(FormatNumber((time2-time1)*1000000,3)) & " 秒 "
Response.Flush
Exit Function
End If
Next
Response.write "成功抓取"&myCount&"條記錄,"
time2=timer()
Response.write "耗時:" & CInt(FormatNumber((time2-time1),3)) & " 秒 "
Response.Flush
'遞迴
GetPart(iGo+1)
End Function%>

本文章原先以中文撰寫並發佈於 aliyun.com，亦設英文版本，僅作資訊用途。本網站不對文章的準確性，完整性或可靠性或其任何翻譯作出任何明示或暗示的陳述或保證。如對該文章有任何疑慮或投訴，請傳送電郵至 info-contact@alibabacloud.com 並提供相關疑慮或投訴的詳細說明。職員會於 5 個工作天內與您聯絡，一經驗證之後，即會刪除該侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

Get Started for Free

Sales Support

1 on 1 presale consultation

Chat Contact Sales
After-Sales Support

24/7 Technical Support 6 Free Tickets per Quarter Faster Response

Open a Ticket
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.

Learn More

XMLHTTP批量抓取遠程資料

聯繫我們

A Free Trial That Lets You Build Big!

Sales Support

After-Sales Support