为什么用Inet访问这个网址 没有返回源代码
If Inet1.StillExecuting = True Then Inet1.Cancel
Inet1.Execute "http://dongchangliduxg.soufun.com/bbs/2424700935~-1/135850007_135850007.htm", "GET"
这样没有返回任何信息 不正常啊 应该得到源代码啊
[解决办法]
普通网站获取代码的函数
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 Function
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
