1,502
社区成员
发帖
与我相关
我的任务
分享
Text2 = Inet1.OpenURL("http://detail.tmall.com/item.htm?id=25854064127")
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 Function getHtmlStr2$(strUrl$)
Const tmpfile As String = "c:\tmp.tmp"
URLDownloadToFile 0, strUrl, tmpfile, 0, 0
Do Until FileLen(tmpfile)
DoEvents
Loop
Dim fn%, tmp$
fn = FreeFile
Open tmpfile For Binary Access Read As #fn
tmp = Space(FileLen(tmpfile))
Get #fn, , tmp
Close #fn
getHtmlStr2 = tmp
End Function
Private Sub Command1_Click()
Command1.Enabled = False
GetHtmlStr Text1
End Sub
Private Sub GetHtmlStr(strUrl As String)
Dim xml As Object
Set xml = CreateObject("msxml2.serverxmlhttp")
xml.Open "GET", strUrl, False
xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xml.setRequestHeader "Accept-Language", "zh-cn"
xml.setRequestHeader "Accept-Encoding", "gzip, deflate"
xml.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; SV1; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)"
xml.send
Do While xml.readyState <> 4
DoEvents
Loop
Text2 = StrConv(xml.ResponseBody, vbUnicode)
Set xml = Nothing
Command1.Enabled = True
End Sub