1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
|
Public Function FTPUploadFile(sLocal As String, sRemote As String) As Boolean
Dim Data(BUFFERSIZE - 1) As Byte
Dim Written As Long
Dim Size As Long
Dim Sum As Long
Dim lBlock As Long
Sum = 0
lBlock = 0
sLocal = Trim(sLocal)
sRemote = Trim(sRemote)
If sLocal <> "" And sRemote <> "" Then
hFile = FtpOpenFile(hConnection, sRemote, GENERIC_WRITE, dwType, 0)
If hFile = 0 Then
ErrorOut Err.LastDllError, "FtpOpenFile:PutFile"
FTPUploadFile = False
Exit Function
End If
Open sLocal For Binary Access Read As #1
Size = LOF(1)
For lBlock = 1 To Size \ BUFFERSIZE
Get #1, , Data
If (InternetWriteFile(hFile, Data(0), BUFFERSIZE, Written) = 0) Then
FTPUploadFile = False
ErrorOut Err.LastDllError, "InternetWriteFile"
Exit Function
End If
DoEvents
Sum = Sum + BUFFERSIZE
RaiseEvent FileTransferProgress(Sum, Size)
Next lBlock
'check for leftovers
If Size Mod BUFFERSIZE <> 0 Then
Get #1, , Data
If (InternetWriteFile(hFile, Data(0), Size Mod BUFFERSIZE, Written) = 0) Then
FTPUploadFile = False
ErrorOut Err.LastDllError, "InternetWriteFile2"
Exit Function
End If
End If
Sum = Size
Close #1
RaiseEvent FileTransferProgress(Sum, Size)
InternetCloseHandle (hFile)
FTPUploadFile = True
End If
End Function |
Partager