Private Sub Command1_Click()
URL = "http://community.csdn.net/Expert/topic/3850/3850250.xml?temp=.7217218"
Set oSend = CreateObject("Microsoft.XMLHTTP")
SourceCode = oSend.open("GET", URL, False)
oSend.send
If Err.Number <> 0 Then Debug.Print Err.Description
SourceCode = bytes2BSTR(oSend.responseBody)
Debug.Print SourceCode
End Sub
Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn, i, 1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn, i + 1, 1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
为什么要用Inet控件下载,用API函数URLDownloadTofile函数多好?
Option Explicit
'声明
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 DownloadFile(URL As String, LocalPath As String) As Boolean
If Not URLDownloadToFile(0, URL, LocalPath, 0, 0) Then
DownloadFile = True
Else
DownloadFile = False
End If
End Function
'实例
Private Sub Command1_Click()
Dim a As Boolean
a = DownloadFile("http://community.csdn.net/Expert/topic/3850/3850250.xml?temp=.888714", "c:\abc.txt")
Debug.Print a
End Sub
我曾经试过下面的方法,但是就是没有什么好的效果.而且老是出错~!~!~!
Dim doc As IHTMLDocument2
Private Sub Inet1_StateChanged(ByVal State As Integer)
If State = 11 Then
InfoLabel.Caption = " 出现错误!可能无法访问网络或其他原因" & vbCrLf
Exit Sub
ElseIf State = 12 Then
HtmlCode = ""
Do '循环接收数据
DoEvents
bufStr = Inet1.GetChunk(1024, icString)
If Len(bufStr) = 0 Then Exit Do
'接受到的所有数据存放在变量 "HtmlCode"中
HtmlCode = HtmlCode & bufStr
Loop
'Text1.Text = HtmlCode '不能超过32k
bufStr = "" '使bufStr为空,保存下面提出的小说
FinalText = CutMark(bufStr)
Text1.Text = FinalText
MousePointer = vbDefault
Timer1.Enabled = True '可以执行下一页面的下载了
End If
End Sub