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