Question

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

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

• 你的回答被采纳后将获得：
• 系统奖励15（财富值+成长值）+难题奖励10（财富值+成长值）+提问者悬赏50（财富值+成长值）

Answer 1

这个不完美,我来补个完美的,并有超时设定,这样抓数据就灰常的可以等待,没有太快的超时了.
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

Answer 2

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

追问

就是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