|
|
楼主 |
发表于 2009-10-13 20:32
|
显示全部楼层
搞定断点继传部分
Public Function FTPDownloadFile(sLocal As String, sRemote As String) As Boolean
On Error GoTo ren
Dim Data(BUFFERSIZE - 1) As Byte ' array of 100 elements 0 to 99
Dim Written As Long
Dim Size As Long
Dim Sum As Long
Dim lBlock As Long
FTPDownloadFile = False
Sum = 0
lBlock = 0
sLocal = Trim(sLocal)
sRemote = Trim(sRemote)
If sLocal <> "" And sRemote <> "" Then
Size = GetFTPFileSize(sRemote) '在FTP上的大小
If Size > 0 Then
If Dir(sLocal) <> "" Then
If MsgBox("是否需在续传", vbYesNo, "友情提示") = vbYes Then Kill (sLocal)
End If
If Dir(sLocal) <> "" Then
localsize = FileLen(sLocal)
If Size > localsize Then
'从上次没有传完的地方开始读取
hFile = FtpOpenFile(hConnection, sRemote, GENERIC_READ, dwType, localsize + 1)
If hFile = 0 Then
ErrorOut Err.LastDllError, "FtpOpenFile:GetFile"
Exit Function
End If
Open sLocal For Binary Access Write As #1
Seek #1, 1
Open szFileLocal & "/" & szFileRemote For Binary Access Write As #1
Seek #1, LOF(1)
Size = Size - LOF(1)
Sum = LOF(1) + 1
timera = Timer '开始下载时间
timerb = Timer '初始化
sizeb = Size
Else
FTPDownloadFile = True
Exit Function
End If
Else
hFile = FtpOpenFile(hConnection, sRemote, GENERIC_READ, dwType, 0)
If hFile = 0 Then
ErrorOut Err.LastDllError, "FtpOpenFile:GetFile"
Exit Function
End If
Open sLocal For Binary Access Write As #1
Seek #1, 1
Sum = 1
timera = Timer '开始下载时间
timerb = Timer '初始化
sizeb = 0
End If
For lBlock = 1 To Size \ BUFFERSIZE
If (InternetReadFile(hFile, Data(0), BUFFERSIZE, Written) = 0) Then
ErrorOut Err.LastDllError, "InternetReadFile"
Close #1
Exit Function
End If
Put #1, , Data
DoEvents
Sum = Sum + BUFFERSIZE
If tzsz = 1 Then Exit Function '强行退出下载
RaiseEvent FileTransferProgress(Sum, Size) '显示进度条
'触发FileTransferProgress事件
Next lBlock
ReDim Data2((Size Mod BUFFERSIZE) - 1) As Byte
If (InternetReadFile(hFile, Data2(0), Size Mod BUFFERSIZE, Written) = 0) Then
ErrorOut Err.LastDllError, "InternetReadFile2"
Close #1
Exit Function
End If
Put #1, , Data2
Sum = Sum + (Size Mod BUFFERSIZE)
Size = Sum
RaiseEvent FileTransferProgress(Sum, Size)
Close #1
InternetCloseHandle (hFile)
FTPDownloadFile = True
Else
FTPDownloadFile = True
End If
End If
Exit Function
ren:
' MsgBox "出错：FTP上不存在这个文件"
End Function |
|
楼主: 彭希仁
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-10-13 13:15
