XMLHTTP批量抓取远程资料(2)
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 & "<BR>"
Response.Flush
End If
Else
Response.write "<font color=red>成功抓取"&myCount&"条记录,"
time2=timer()
Response.write "耗时:" & Int(FormatNumber((time2-time1)*1000000,3)) & " 秒</font><BR>"
Response.Flush
Exit Function
End If
Next
Response.write "<font color=red>成功抓取"&myCount&"条记录,"
time2=timer()
Response.write "耗时:" & CInt(FormatNumber((time2-time1),3)) & " 秒</font><BR>"
Response.Flush
'递归
GetPart(iGo+1)
End Function%>
内容版权声明:除非注明,否则皆为本站原创文章。