Option Explicit
Public Const INTERNET_OPEN_TYPE_DIRECT = 1 ' direct to net
Public Const INTERNET_OPEN_TYPE_PROXY = 3 ' via named proxy
Public Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 ' prevent using java/script/INS
Public Const INTERNET_FLAG_PASSIVE = &H8000000 ' used for FTP connections
Public Const INTERNET_FLAG_RELOAD = &H80000000
' additional cache flags
Public Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 ' don't write this item to the cache
' additional flags
Public Const INTERNET_DEFAULT_FTP_PORT = 21 ' default for FTP servers
Public Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000 ' FTP: use existing InternetConnect handle for server if possible
Public Const INTERNET_SERVICE_FTP = 1
Public Declare Function InternetOpen Lib "Wininet.dll" _
Alias "InternetOpenA" _
(ByVal lpszAgent As String, _
ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Public Declare Function InternetCloseHandle Lib "Wininet.dll" _
(ByVal hEnumHandle As Long) As Long
Public Declare Function InternetConnect Lib "Wininet.dll" _
Alias "InternetConnectA" _
(ByVal hInternet As Long, _
ByVal lpszServerName As String, _
ByVal nServerPort As Long, _
ByVal lpszUserName As String, _
ByVal lpszPassword As String, _
ByVal dwService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Public Declare Function FtpGetFile Lib "Wininet.dll" _
Alias "FtpGetFileA" _
(ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private hInternet As Long
Private hConnect As Long
Public Function LoadFromInternetWithFTP(ftpServerName As String, ftpUserName As String, ftpPassword As String _
, strSourceFile As String, strTargetFile As String, strErrorMsg As String) As Boolean
Screen.MousePointer = vbHourglass
hInternet = InternetOpen("Vb FTP Transfer", INTERNET_OPEN_TYPE_DIRECT, _
vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE)
If hInternet Then
' Try first passive
hConnect = InternetConnect(hInternet, ftpServerName, INTERNET_DEFAULT_FTP_PORT, ftpUserName, _
ftpPassword, INTERNET_SERVICE_FTP, INTERNET_FLAG_EXISTING_CONNECT Or _
INTERNET_FLAG_PASSIVE, &H0)
If hConnect = 0 Then
' Then active connection
hConnect = InternetConnect(hInternet, ftpServerName, INTERNET_DEFAULT_FTP_PORT, ftpUserName, _
ftpPassword, INTERNET_SERVICE_FTP, INTERNET_FLAG_EXISTING_CONNECT Or _
INTERNET_FLAG_RELOAD, &H0)
End If
If hConnect <> 0 Then
If FtpGetFile(hConnect, strSourceFile, strTargetFile, False, &H20, &H0, 0&) Then
LoadFromInternetWithFTP = True
End If
End If
End If
'Close FTP
Call InternetCloseHandle(hConnect)
Call InternetCloseHandle(hInternet)
hInternet = 0
hConnect = 0
Screen.MousePointer = vbDefault
End Function