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%> 

内容版权声明:除非注明,否则皆为本站原创文章。

转载注明出处:http://www.heiqu.com/3665.html