使用XMLHTTP下載基於HTTP協議傳輸的檔案，如果檔案較大，一般可以考慮使用非同步方式，但VB裡XMLHTTP非同步仍然會造成執行緒阻塞，如何避免這種情況，本文章就此作了一個演示：

'* ************************************** * '* 模組名稱：Form1.frm '* 模組功能：使用XMLHTTP元件實現HTTP協議下的斷點續傳 '* 作者：lyserver '* ************************************** * Dim m_blnStop As Boolean '* ------------------------------------------- ' 函式說明：基於XMLHTTP的資料下載函式（支援斷點續傳） ' 引數說明：URL待下載的URL ' FileName儲存下載結果的檔案 ' BlockSize分塊大下，根據網路情況而定，以便VB能及時執行DoEvents來獲得滑鼠和鍵盤動作並重新整理介面 ' ResumeTransfer是否支援斷點續傳 ' 編碼：lyserver '* ------------------------------------------- Private Sub DownFileByHTTP(ByVal URL As String, FileName As String, Optional BlockSize As Long = 4096, Optional ResumeTransfer As Boolean) Dim xmlHttp As Object Dim bytData() As Byte Dim i As Long, fn As Integer, lTotalSize As Long '獲得檔案長度 Set xmlHttp = CreateObject("MSXML2.XMLHTTP") xmlHttp.open "HEAD", URL, False xmlHttp.send lTotalSize = xmlHttp.getResponseHeader("Content-Length") Set xmlHttp = Nothing '開啟檔案 fn = FreeFile() Open FileName For Binary As #fn '判斷是否需要斷點續傳 If ResumeTransfer = True Then i = LOF(fn) Seek fn, i + 1 End If '分塊下載資料，並儲存到檔案中 m_blnStop = False '重置中斷標誌 Do While i < lTotalSize And m_blnStop = False '沒有使用For迴圈是因為需要下載數與實際下載數可能不一致 '獲得檔案資料 Set xmlHttp = CreateObject("MSXML2.XMLHTTP") xmlHttp.open "GET", URL, False xmlHttp.setRequestHeader "Referer", Left(URL, InStr(InStr(URL, "//") + 2, URL, "/") - 1) xmlHttp.setRequestHeader "Accept", "*/*" xmlHttp.setRequestHeader "User-Agent", "lyserver" xmlHttp.setRequestHeader "Range", "bytes=" & i & "-" & CStr(i + IIf(lTotalSize - i > BlockSize, BlockSize, lTotalSize - i) - 1) '分段 xmlHttp.setRequestHeader "Content-Type", "application/octet-stream" xmlHttp.setRequestHeader "Pragma", "no-cache" xmlHttp.setRequestHeader "Cache-Control", "no-cache" xmlHttp.send '轉換為位元組陣列 bytData = xmlHttp.responseBody Set xmlHttp = Nothing '儲存到檔案中 Put fn, , bytData '重置下載開始位置 i = i + UBound(bytData) + 1 '釋放控制權 DoEvents '顯示進度 Debug.Print VBA.FormatPercent(i / lTotalSize) Loop Close fn End Sub Private Sub Command1_Click() '下載，由於在區域網內測試，因此分塊設定較大（400K） DownFileByHTTP "HTTP://192.168.1.134/Vbe600chs1.rar", "c:/temp.rar", 409600, True If m_blnStop = True Then MsgBox "資料下載被中斷！", vbCritical, "提示" Else MsgBox "資料下載完畢！", vbInformation, "提示" End If End Sub Private Sub Command2_Click() '中斷下載 m_blnStop = True End Sub