vb6用xmlhttp的方法获取网站源代码 -2147024891（80070005）错误

Posted 2023-05-05

Private Function gethtmlStr(strUrl As String) As String
Dim XmlHttp As Object
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "GET", strUrl, False
XmlHttp.send
getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
Set XmlHttp = Nothing
End Function

我用xmlhttp的方法来获取网站的源代码，可是总是出现 “运行时错误 -2147024891（80070005），拒绝访问” 的错误。
请问如何能解决这个问题。
网站是http://detail.tmall.com/item.htm?id=25854064127

不想用webbrowser，实在太耗资源。
我获取网页源代码的目的是得到网页中商品的图片和其他一些内容。
如果解决不了，那有没有其他好点的办法？

参考技术A 这个不完美,我来补个完美的,并有超时设定,这样抓数据就灰常的可以等待,没有太快的超时了.
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 参考技术B 点调试后是提示哪行有错？
我用你的同样代码、同样网站测试没有出现错误。追问

就是send时出错，好像是天猫网站的某种特殊设计。

有网友用msxml2.serverxmlhttp来get，我试了可以，但是他的参数比较复杂，不太明白。字数超了，我就截图了，我觉得你一看就能明白问题所在。（Microsoft.XMLHTTP不行，msxml2.serverxmlhttp可以）

网上有一种api的方法URLDownloadToFile ，我暂时用的这个api，不知孰好孰坏。

追答

你就直接把你的代码中的Microsoft.XMLHTTP改为msxml2.serverxmlhttp即可，其他不用改，这个表示的是xmlhttp组件的版本，Microsoft.XMLHTTP是最早的版本，我的电脑上装有这个版本，所以我的不会出错，你的没有所以就出错。

URLDownloadToFile是把网址直接保存到文件，用法举例：
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub Command1_Click()
URLDownloadToFile 0&, "http://detail.tmall.com/item.htm?id=25854064127", App.Path & "\tmall.htm", 0&, 0&
MsgBox "网页已下载为" & App.Path & "\tmall.htm"
End Sub

vb 获取网络时间较快的代码

如题，目前百度搜到的一些VB代码，执行好像都比较慢，甚至死机，能否给一段执行较快效率高的代码（本人看到其他一些知名软件获取网络时间非常快，每次都只要一秒，软件的名称我就不说了），不甚感谢，可以帖出，也可以发我919570050.
我用的是vb 6.0

直接用vb转换GMT时间

Private Function getWebDatetime() As String

Dim XmlHttp As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "http://www.baidu.com", False

XmlHttp.send

getWebDatetime = CDate(1 / 3 + CDbl(CDate(Mid$(XmlHttp.getResponseHeader("Date"), 5, 21))))

Set XmlHttp = Nothing

End Function

扩展资料：

读取网站服务器返回的时间的代码

Private Function getWebDatetime() As String

Dim XmlHttp As Object, objJs As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "http://www.baidu.com", False

XmlHttp.send

Set objJs = CreateObject("msscriptcontrol.scriptcontrol")

objJs.Language = "jScript"

getWebDatetime = objJs.Eval("var dt = new Date('" & XmlHttp.getResponseHeader("Date") & "');var date = [  [dt.getFullYear(), dt.getMonth() + 1, dt.getDate()].join('-'),  [dt.getHours(), dt.getMinutes(), dt.getSeconds()].join(':')].join(' ').replace(/(?=\\b\\d\\b)/g, '0');date;")

Set XmlHttp = Nothing

Set objJs = Nothing

End Function

参考技术A 函数：返回格式yyyy-M-d hh:mm:ss的日期时间，默认从国家授时中心网站获取（比较慢），原理，获取网站的http头，从头中得到服务器的日期时间，只要服务器日期时间准确则获取的日期时间就是准确的，可以从大网站获取，速度快且准确
Function getDateTime(Optional url As String) As String
    Dim xmlhttp
    Dim dt As String
    Dim m As Integer, n As Integer

    On Error Resume Next
    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    If url = "" Then url = "http://www.time.ac.cn"
    With xmlhttp
        .Open "Get", url, False, "", ""
        .setRequestHeader "If-Modified-Since", "0"
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Connection", "close"
        .Send
        dt = .getAllResponseHeaders()
        m = InStr(1, dt, "Date:", vbTextCompare)
        n = InStr(1, dt, "GMT", vbTextCompare)
        If m > 0 Then getDateTime = CDate(Trim(Split(Mid(dt, m + 5, n - m - 5), ",")(1))) + #8:00:00 AM#
    End With
    Set xmlhttp = Nothing
End Function
调用方法：
dt=getDateTime("http://www.baidu.com")  '从百度服务器获取时间，我这里获取很快（毫秒级），取决于你访问百度的速度
dt=getDateTime()  '从国家授时中心获取时间，我这里访问比较慢

追问

谢谢，我输入QQ.com，速度较快，能不能给一段判断网络是否连接的代码，判断速度也快一的

本回答被提问者采纳