vb6用xmlhttp的方法获取网站源代码 -2147024891(80070005)错误_百度...

发布网友发布时间：2024-10-06 11:09

共2个回答

热心网友时间：2024-11-14 14:51

这个不完美,我来补个完美的,并有超时设定,这样抓数据就灰常的可以等待,没有太快的超时了.
Public Function getHtmlStr(strURL)
On Error GoTo ErrorHandler
Dim XmlHttp As Object
Set XmlHttp = Nothing
Set XmlHttp = CreateObject("msxml2.serverxmlhttp")
XmlHttp.Open "GET", strURL, True ' false同步,true异步
XmlHttp.SetTimeouts 10000, 10000, 10000, 30000
XmlHttp.send

Dim waitTimeOut, secondNumber
waitTimeOut = 0
secondNumber = 30 '超时多少秒
Do
DoEvents
wait 10
waitTimeOut = waitTimeOut + 1
Loop Until (XmlHttp.ReadyState = 4 Or waitTimeOut >= 100 * secondNumber)

If XmlHttp.ReadyState = 4 Then
getHtmlStr = XmlHttp.Responsebody
lianjie = True
Set XmlHttp = Nothing
Exit Function
End If
ErrorHandler:
lianjie = False
Set XmlHttp = Nothing
End Function
上面是函数.下面是调用示例:
Dim ss As String
ss = BytesToBstr(getHtmlStr(Text1.Text), "utf-8") & vbCrLf
If lianjie = True Then
PASSRichTextBox3.Text = "采集成功"
Else
PASSRichTextBox3.Text = "采集失败"
End If
'Public Function BytesToBstr(strBody, CodeBase)
' On Error Resume Next
' Dim ObjStream
' Set ObjStream = CreateObject("Adodb.Stream")
' With ObjStream
' .Type = 1
' .Mode = 3
' .open
' .Write strBody
' .Position = 0
' .Type = 2
' .charset = CodeBase
' BytesToBstr = .ReadText
' .Close
' End With
' Set ObjStream = Nothing
'End Function

热心网友时间：2024-11-14 14:45

点调试后是提示哪行有错？
我用你的同样代码、同样网站测试没有出现错误。