急!!VB使用xmlhttp 分块下载大文件
我用vb 下载文件 文件小没有问题,文件大就会死掉 ,根据一般下载软件的分块下载,边下载边写文件,怎么下载完成的文件不能打开,下载后的文件比要下载的文件多几个字节,是怎么回事??
xmlRequest.open "HEAD", strUrl, True ' strUrl要下载的文件的地址
xmlRequest.send Null
'等待返回信息
Do Until xmlRequest.readyState = 4
DoEvents
Loop
strFileLen = xmlRequest.getResponseHeader("Content-Length") '获取下载的文件长度6186
Num = strFileLen \ 4096
If Dir(UpdataPath & NewFile) <> "" Then
Kill UpdataPath & NewFile
End If
If Dir(UpdataPath, vbDirectory) = "" Then
MkDir UpdataPath
End If
FileNum = FreeFile
Open UpdataPath & NewFile For Binary As #FileNum '二进制打开文件
For i = 0 To Num
xmlRequest.open "GET", strUrl, True
'xmlRequest.setRequestHeader "Type", "application/octet-stream"
If i = Num Then
xmlRequest.setRequestHeader "Range", "bytes=" & i * 4096 & "-"
Else
xmlRequest.setRequestHeader "Range", "bytes=" & i * 4096 & "-" & (i + 1) * 4096 - 1
End If
xmlRequest.send Null
'等待返回信息
Do Until xmlRequest.readyState = 4
DoEvents
Loop
'判断是否还有下载
' NowFileLen = xmlRequest.getResponseHeader("Content-Length")
' ReDim FileBuff(CLng(NowFileLen) - 1)
' CopyMemory FileBuff(0), xmlRequest.responseBody(0), CLng(NowFileLen)
Put #FileNum, , xmlRequest.responseBody
' adoStream.Type = adTypeBinary
' adoStream.open
' adoStream.LoadFromFile UpdataPath & NewFile
' adoStream.Position = i * 4096
' adoStream.Write xmlRequest.responseStream
' adoStream.SaveToFile UpdataPath & NewFile, adSaveCreateOverWrite
' adoStream.Close
'
Next i
Public xmlRequest As MSXML2.XMLHTTP
Public Event Complete()
Public Sub DownProc() '通过“工具”菜单下的“过程属性”菜单项弹出的过程属性对话框中“高级”按钮设置本过程为默认过程。
If xmlRequest.readyState = 4 Then
RaiseEvent Complete
End If
End Sub
Dim m_xmlRequest As New MSXML2.XMLHTTP
Dim WithEvents m_EventHandler As xmlEvent
Private Sub Command1_Click()
'获得文件长度
m_xmlRequest.open "HEAD", "HTTP://192.168.1.134/Vbe600chs1.rar", False
m_xmlRequest.send
Debug.Print "文件长度:", m_xmlRequest.getResponseHeader("Content-Length")
'获得文件数据
Set m_xmlRequest = New MSXML2.XMLHTTP
Set m_EventHandler = New xmlEvent
Set m_EventHandler.xmlRequest = m_xmlRequest
m_xmlRequest.onreadystatechange = m_EventHandler
m_xmlRequest.open "GET", "HTTP://192.168.1.134/Vbe600chs1.rar", True
m_xmlRequest.send
End Sub
Private Sub m_EventHandler_Complete()
'保存下载结果
Open "c:\temp.rar" For Binary As #1
Put #1, , m_xmlRequest.responseBody
Close #1
Debug.Print "下载文件长度:", UBound(m_xmlRequest.responseBody) + 1
End Sub