为什么用Inet访问这个网址 没有返回源代码

Question

If Inet1.StillExecuting = True Then Inet1.Cancel
Inet1.Execute "http://dongchangliduxg.soufun.com/bbs/2424700935~-1/135850007_135850007.htm", "GET"
这样没有返回任何信息  不正常啊 应该得到源代码啊

Answer 1

普通网站获取代码的函数Private Function getHtmlStr$(strURL$) '获取源码
    On Error GoTo reStart
reStart:
    DoEvents
    Dim stime, ntime
    Dim XmlHttp
    ' St "获取网页源码"
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET", strURL, True
    XmlHttp.SetRequestHeader "If-Modified-Since", "0"
    XmlHttp.Send
    stime = Now '获取当前时间
    While XmlHttp.ReadyState <> 4
        DoEvents
        ntime = Now '获取循环时间
        If DateDiff("s", stime, ntime) > 10 Then getHtmlStr = "OutTime":Exit Function '判断超出3秒即超时退出过程
    Wend
    getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
    If getHtmlStr = "" Then getHtmlStr = "OutTime"
    Set XmlHttp = Nothing
    DoEvents
End FunctionUTF-8网站获取源代码的函数：Function Utf8ToUnicode(ByRef Utf() As Byte) As String
    Dim utfLen As Long
    
    utfLen = -1
    On Error Resume Next
    utfLen = UBound(Utf)
    If utfLen = -1 Then Exit Function
    
    On Error GoTo 0
    
    Dim i As Long, j As Long, k As Long, N As Long
    Dim B As Byte, cnt As Byte
    Dim Buf() As String
    ReDim Buf(utfLen)
    
    i = 0
    j = 0
    Do While i <= utfLen
        B = Utf(i)
        
        If (B And &HFC) = &HFC Then
            cnt = 6
        ElseIf (B And &HF8) = &HF8 Then
            cnt = 5
        ElseIf (B And &HF0) = &HF0 Then
            cnt = 4
        ElseIf (B And &HE0) = &HE0 Then
            cnt = 3
        ElseIf (B And &HC0) = &HC0 Then
            cnt = 2
        Else
            cnt = 1
        End If
        
        If i + cnt - 1 > utfLen Then
            Buf(j) = "?"
            Exit Do
        End If
        
        Select Case cnt
        Case 2
            N = B And &H1F
        Case 3
            N = B And &HF
        Case 4
            N = B And &H7
        Case 5
            N = B And &H3
        Case 6
            N = B And &H1
        Case Else
            Buf(j) = Chr(B)
            GoTo Continued:
        End Select
                
        For k = 1 To cnt - 1
            B = Utf(i + k)
            N = N * &H40 + (B And &H3F)
        Next
        
        Buf(j) = ChrW(N)
Continued:
        i = i + cnt
        j = j + 1
    Loop
    
    Utf8ToUnicode = Join(Buf, "")
 End Function
Function getHtmlStr$(strURL$) '获取源码
    On Error GoTo reStart
    Dim smt() As Byte
reStart:
    DoEvents
    Dim stime, ntime
    Dim XmlHttp
    ' St "获取网页源码"
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET", strURL, True
    XmlHttp.SetRequestHeader "If-Modified-Since", "0"
    XmlHttp.Send
    stime = Now '获取当前时间
    While XmlHttp.ReadyState <> 4
        DoEvents
        ntime = Now '获取循环时间
        If DateDiff("s", stime, ntime) > 5 Then getHtmlStr = "OutTime": Exit Function  '判断超出3秒即超时退出过程
        DoEvents
    Wend
    'getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
    smt = XmlHttp.ResponseBody
    getHtmlStr = Utf8ToUnicode(smt)
    If getHtmlStr = "" Then getHtmlStr = "OutTime"
    Set XmlHttp = Nothing
    DoEvents
End Function