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:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
|
Option Explicit
'egl1044
Private Const BUF_SIZE = 4096 ' 4KB default buffer for FTP
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const OPEN_EXISTING = &H3&
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const FTP_TRANSFER_TYPE_UNKNOWN = 0
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnectW Lib "wininet" (ByVal hInternetSession As Long, ByVal sServerName As Long, ByVal nServerPort As Long, ByVal sUsername As Long, ByVal sPassword As Long, ByVal lService As Long, ByVal lFlags As Long, ByVal lcontext As Long) As Long
Private Declare Function InternetWriteFile Lib "wininet" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToWrite As Long, ByRef lpdwNumberOfBytesWritten As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long
Private Declare Function FtpOpenFileW Lib "wininet" (ByVal hConnect As Long, ByVal lpszFileName As Long, ByVal dwAccess As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Dim Buffer(BUF_SIZE) As Byte
Dim dwReadBytes As Long
Dim dwWrittenBytes As Long
Dim hOpen As Long
Dim hConnect As Long
Dim hInternet As Long
Dim hFile As Long
Public Sub FtpPutFileEx( _
ByVal szServer As String, _
ByVal szUser As String, _
ByVal szPassword As String, _
ByVal szLocalFile As String, _
ByVal szServerFile As String)
Dim dwStatus As Long
Dim dwLoFileSize As Long
Dim dwHiFileSize As Long
Dim dwPercent As Long
'// init
hOpen = InternetOpenW(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
'// connect to the ftp server
hConnect = InternetConnectW(hOpen, StrPtr(szServer), INTERNET_DEFAULT_FTP_PORT, StrPtr(szUser), StrPtr(szPassword), INTERNET_SERVICE_FTP, 0, 0)
If hConnect = 0 Then
CleanUp
Debug.Print "InternetConnectW()" & Err.LastDllError
Exit Sub
End If
'// get handle for filename that will be written to the ftp server
hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, FTP_TRANSFER_TYPE_UNKNOWN, 0)
If hInternet = 0 Then
CleanUp
Debug.Print "FtpOpenFile()" & Err.LastDllError
Exit Sub
End If
'// get handle for local file to read bytes
hFile = CreateFileW(StrPtr("\\?\" & szLocalFile), GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0)
If hFile = INVALID_HANDLE_VALUE Then
CleanUp
Debug.Print "CreateFileW()" & Err.LastDllError
Exit Sub
End If
' // get local file size for progress. This example supports
' only up to 2GB of status reporting progress.
dwLoFileSize = GetFileSize(hFile, dwHiFileSize)
'// read local file, write server file bytes
Do
If ReadFile(hFile, VarPtr(Buffer(0)), BUF_SIZE, dwReadBytes, 0) Then
If InternetWriteFile(hInternet, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes) Then
' Track the amount of bytes written and percentage.
dwStatus = (dwStatus + dwWrittenBytes)
dwPercent = (dwStatus / dwLoFileSize) * 100
'Label1.Caption = dwPercent
End If
Else
Exit Do
End If
DoEvents
Loop Until dwReadBytes = 0
Debug.Print "Done"
'// cleanup
CleanUp
Erase Buffer
End Sub
Private Sub CleanUp()
If hOpen <> 0 Then
InternetCloseHandle hOpen
hOpen = 0
End If
If hConnect <> 0 Then
InternetCloseHandle hConnect
hConnect = 0
End If
If hInternet <> 0 Then
InternetCloseHandle hInternet
hInternet = 0
End If
If hFile > 0 Then
CloseHandle hFile
hFile = INVALID_HANDLE_VALUE
End If
End Sub
|
