Just paste this source code into a class module called cFTP and include it in your project.
'----------------------------------------------------------------------
'
' Module Name: cFTP
' Written By: C&D Programming Corp.
' Create Date: 8/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'============================================================
' WinInet API declarations
'============================================================
'
' Initializes an application's use of the Win32 Internet functions
'
Private Declare Function InternetOpen Lib "wininet.dll" _
Alias "InternetOpenA" _
(ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
'
' Reads from an Internet handle, in this case we are using it to
' read a file from an FTP server.
'
Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Boolean
'
' Closes a single Internet handle or a subtree of Internet handles.
'
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
'
' Opens a HTTP/FTP session for a given site.
'
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, ByVal sUsername As String, _
ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
'
' Retrieves a file using the FTP protocol
'
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
'
' Changes the directory on the remote server
'
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
'
' Used to open and FTP file and allow small chunks to be read/written
' so that status information can be provided to the user
'
Private Declare Function FtpOpenFile Lib "wininet.dll" _
Alias "FtpOpenFileA" _
(ByVal hFtpSession As Long, _
ByVal sFilename As String, ByVal lAccess As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
' User agent constant.
Private Const scUserAgent = "vb5 wininet"
' Use registry access settings.
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
' This is the type of service that you are connecting to
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
' These are the available FTP transfer types.
Private Const FTP_TRANSFER_TYPE_ASCII = &H1 ' one of these are wrong
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
' Brings the data across the wire even if it locally cached.
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000
' for use with the FtpOpenFile function
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
'============================================================
' declares for retrieving file information
'============================================================
Private Const ERROR_NO_MORE_FILES = 18
Private Const MAX_PATH = 260
Private Const NO_ERROR = 0
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As Currency ' This allows the right size variable
ftLastAccessTime As Currency ' and the best accuracy. It is easier
ftLastWriteTime As Currency ' then passing FILETIME. I first saw
nFileSizeHigh As Long ' this in the book Hardcore Visual Basic.
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'
' This routine allows us to get the filesize for the FTP servers
' that support it.
'
Private Declare Function FtpFindFirstFile Lib "wininet.dll" _
Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, _
ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, _
ByVal dwContent As Long) As Long
Private Const INTERNET_INVALID_PORT_NUMBER = 0 ' used to get a port number in the
' InternetConnect call
Private Const INTERNET_FLAG_PASSIVE = &H8000000
'
' information to retrieve error codes and messages
'
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
'============================================================
' Error constants for the WinInet API
'============================================================
Private Const ERROR_INTERNET_OUT_OF_HANDLES = 12001
Private Const ERROR_INTERNET_TIMEOUT = 12002
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Private Const ERROR_INTERNET_INTERNAL_ERROR = 12004
Private Const ERROR_INTERNET_INVALID_URL = 12005
Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = 12006
Private Const ERROR_INTERNET_NAME_NOT_RESOLVED = 12007
Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = 12008
Private Const ERROR_INTERNET_INVALID_OPTION = 12009
Private Const ERROR_INTERNET_BAD_OPTION_LENGTH = 12010
Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE = 12011
Private Const ERROR_INTERNET_SHUTDOWN = 12012
Private Const ERROR_INTERNET_INCORRECT_USER_NAME = 12013
Private Const ERROR_INTERNET_INCORRECT_PASSWORD = 12014
Private Const ERROR_INTERNET_LOGIN_FAILURE = 12015
Private Const ERROR_INTERNET_INVALID_OPERATION = 12016
Private Const ERROR_INTERNET_OPERATION_CANCELLED = 12017
Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = 12018
Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = 12019
Private Const ERROR_INTERNET_NOT_PROXY_REQUEST = 12020
Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = 12021
Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = 12022
Private Const ERROR_INTERNET_NO_DIRECT_ACCESS = 12023
Private Const ERROR_INTERNET_NO_CONTEXT = 12024
Private Const ERROR_INTERNET_NO_CALLBACK = 12025
Private Const ERROR_INTERNET_REQUEST_PENDING = 12026
Private Const ERROR_INTERNET_INCORRECT_FORMAT = 12027
Private Const ERROR_INTERNET_ITEM_NOT_FOUND = 12028
Private Const ERROR_INTERNET_CANNOT_CONNECT = 12029
Private Const ERROR_INTERNET_CONNECTION_ABORTED = 12030
Private Const ERROR_INTERNET_CONNECTION_RESET = 12031
Private Const ERROR_INTERNET_FORCE_RETRY = 12032
Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST = 12033
Private Const ERROR_INTERNET_HANDLE_EXISTS = 12036
Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = 12037
Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID = 12038
Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = 12039
Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = 12040
Private Const ERROR_INTERNET_MIXED_SECURITY = 12041
Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = 12042
Private Const ERROR_INTERNET_POST_IS_NON_SECURE = 12043
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS = 12110
Private Const ERROR_FTP_DROPPED = 12111
Private Const ERROR_GOPHER_PROTOCOL_ERROR = 12130
Private Const ERROR_GOPHER_NOT_FILE = 12131
Private Const ERROR_GOPHER_DATA_ERROR = 12132
Private Const ERROR_GOPHER_END_OF_DATA = 12133
Private Const ERROR_GOPHER_INVALID_LOCATOR = 12134
Private Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE = 12135
Private Const ERROR_GOPHER_NOT_GOPHER_PLUS = 12136
Private Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND = 12137
Private Const ERROR_GOPHER_UNKNOWN_LOCATOR = 12138
Private Const ERROR_HTTP_HEADER_NOT_FOUND = 12150
Private Const ERROR_HTTP_DOWNLEVEL_SERVER = 12151
Private Const ERROR_HTTP_INVALID_SERVER_RESPONSE = 12152
Private Const ERROR_HTTP_INVALID_HEADER = 12153
Private Const ERROR_HTTP_INVALID_QUERY_REQUEST = 12154
Private Const ERROR_HTTP_HEADER_ALREADY_EXISTS = 12155
Private Const ERROR_HTTP_REDIRECT_FAILED = 12156
Private Const ERROR_INTERNET_FIRST_ERROR = ERROR_INTERNET_OUT_OF_HANDLES
' add 50 just in case there are a few others Microsoft forgot to document.
Private Const ERROR_INTERNET_LAST_ERROR = ERROR_HTTP_REDIRECT_FAILED + 50
'============================================================
' Public variables
'============================================================
Public ProxyServer As String ' proxy server to use when creating a session
Public ServerName As String ' name of the server to connect to
Public SourceFilename As String ' full path/filename of the file being read when using
' the transferring files
Public DestinationFilename As String
' full path/filename of the file being saved when using
' the transferring files
Public Username As String ' username to use to connect to server
' these are optional if the FTP server
' accept anonymous connections
Public Password As String ' password to use to connect to server
Public PassiveMode As Boolean ' True uses passive FTP semantics
Public BinaryMode As Boolean ' True if the file should be transferred
' in binary mode, False if it should
' use ASCII mode
Public BufferSize As Long ' used in the OneStepDownloadWithStatus for
' setting the transfer buffer size
'============================================================
' Events raised by this class
'============================================================
' We use Currency variables since they are larger integers
' (sort of) and allows us to accurately show file sizes
' and transfer bytes greater than what a Long can contain
' (about 2 gigabytes)
Public Event TransferProgress(lBytesRead As Long, _
curTotalBytes As Currency, _
curFileSize As Currency)
Public Event TransferComplete(curTotalBytes As Currency)
'============================================================
' Private variables
'============================================================
Dim mhSession As Long ' handle to internet session
Dim mhConnection As Long ' handle to connection to server
'
' Initialize the communications session either by proxy server or
' direct connection. If it can not open the connection, raise
' an error.
'
Public Sub InitSession()
If Len(ProxyServer) <> 0 Then
mhSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, ProxyServer, vbNullString, 0)
Else
mhSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
End If
If mhSession = 0 Then
Err.Raise Err.LastDllError, "InitSession", ErrorMessage(Err.LastDllError)
End If
End Sub
'
' Connect to the FTP server. If the session was not initialized yet,
' call InitSession to start it. Otherwise open the connection and
' exit. Raise an error if not successful.
'
Public Sub ConnectToServer()
Dim lFlag As Long
On Error GoTo Handler
If mhSession = 0 Then
InitSession
End If
If mhConnection <> 0 Then
Exit Sub
End If
If PassiveMode Then
lFlag = INTERNET_FLAG_PASSIVE
Else
lFlag = 0
End If
mhConnection = InternetConnect(mhSession, ServerName, INTERNET_INVALID_PORT_NUMBER, _
Username, Password, INTERNET_SERVICE_FTP, lFlag, 0)
If mhConnection = 0 Then
Dim sErr As String
sErr = ErrorMessage(Err.LastDllError)
Err.Raise Err.LastDllError, "InternetConnect", sErr
End If
Exit Sub
Handler:
Err.Raise Err.Number, "ConnectToServer", ErrorMessage(Err.LastDllError)
End Sub
Public Sub DisconnectFromServer()
If mhConnection <> 0 Then
Call InternetCloseHandle(mhConnection)
mhConnection = 0
End If
End Sub
Public Sub TerminateSession()
If mhSession <> 0 Then
Call InternetCloseHandle(mhSession)
mhSession = 0
End If
End Sub
Public Sub Download()
Dim bRet As Boolean
Dim sFileRemote As String
Dim sDirRemote As String
Dim sFileLocal As String ' the local filename
Dim lDataType As Long ' data type to transfer the file with binary/ascii
Dim lPos As Long
On Error GoTo Handler
'
' Do some data validation on the source filename and
' the destination filename
'
If SourceFilename = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a source filename, such as /public/filename.zip"
Exit Sub
End If
If Trim$(DestinationFilename) = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a filename to store the downloaded data, such as c:\download\filename.zip"
Exit Sub
End If
'
' try to connect to server. If we can't connect, raise an error.
'
On Error Resume Next
ConnectToServer
If Err Then
Err.Raise 5, "DownloadFile", "Could not connect to server " & ServerName & ". Error was '" & Err.Description & "'"
Exit Sub
End If
On Error GoTo Handler
' break apart filename for passing to the FtpGetFile call
' we need to do this because the FtpGetFile call will not
' automatically change the directory on the ftp server. So,
' we first have to determine the directory and then do a
' remote change directory call to position the ftp server
' to the correct place. After this, we can successfully
' transfer the file.
sFileRemote = SourceFilename
lPos = FindLastOccurrence(sFileRemote, "/")
sDirRemote = Left(sFileRemote, lPos)
sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
sFileLocal = DestinationFilename
' change remote directory to sDirRemote
RemoteChangeDir sDirRemote
' set the data transfer mode
If BinaryMode Then
lDataType = FTP_TRANSFER_TYPE_BINARY
Else
lDataType = FTP_TRANSFER_TYPE_ASCII
End If
' get the file
bRet = FtpGetFile(mhConnection, sFileRemote, sFileLocal, False, _
INTERNET_FLAG_RELOAD, lDataType, 0&)
If Not bRet Then
DisconnectFromServer
TerminateSession
Else
Err.Raise Err.LastDllError, "FtpGetFile", ErrorMessage(Err.LastDllError)
End If
Exit Sub
Handler:
Err.Raise Err.Number, "OneStepDownload", Err.Description
End Sub
Private Sub RemoteChangeDir(sDir As String)
Dim bRet As Boolean
' if the directory is blank, let's assume they really mean the
' root directory
If sDir = "" Then sDir = "/"
bRet = FtpSetCurrentDirectory(mhConnection, sDir)
If bRet = False Then
Err.Raise Err.LastDllError, "RemoteChangeDir", ErrorMessage(Err.LastDllError)
End If
End Sub
Function InternetErrorMessage(dError As Long) As String
Dim sMsg As String
sMsg = ""
Select Case dError
Case ERROR_INTERNET_OUT_OF_HANDLES ' 12001
sMsg = "No more handles could be generated at this time."
Case ERROR_INTERNET_TIMEOUT ' 12002
sMsg = "The request has timed out."
Case ERROR_INTERNET_EXTENDED_ERROR ' 12003
sMsg = "An extended error was returned from the server. This is typically a string or buffer containing a verbose error message. Call InternetGetLastResponseInfo to retrieve the error text."
Case ERROR_INTERNET_INTERNAL_ERROR ' 12004
sMsg = "An internal error has occurred."
Case ERROR_INTERNET_INVALID_URL ' 12005
sMsg = "The URL is invalid."
Case ERROR_INTERNET_UNRECOGNIZED_SCHEME ' 12006
sMsg = "The URL scheme could not be recognized or is not supported."
Case ERROR_INTERNET_NAME_NOT_RESOLVED ' 12007
sMsg = "The server name could not be resolved."
Case ERROR_INTERNET_PROTOCOL_NOT_FOUND ' 12008
sMsg = "The requested protocol could not be located."
Case ERROR_INTERNET_INVALID_OPTION ' 12009
sMsg = "A request to InternetQueryOption or InternetSetOption specified an invalid option value."
Case ERROR_INTERNET_BAD_OPTION_LENGTH ' 12010
sMsg = "The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified."
Case ERROR_INTERNET_OPTION_NOT_SETTABLE ' 12011
sMsg = "The request option cannot be set, only queried."
Case ERROR_INTERNET_SHUTDOWN ' 12012
sMsg = "The Win32 Internet function support is being shut down or unloaded."
Case ERROR_INTERNET_INCORRECT_USER_NAME ' 12013
sMsg = "The request to connect and log on to an FTP server could not be completed because the supplied user name is incorrect."
Case ERROR_INTERNET_INCORRECT_PASSWORD ' 12014
sMsg = "The request to connect and log on to an FTP server could not be completed because the supplied password is incorrect."
Case ERROR_INTERNET_LOGIN_FAILURE ' 12015
sMsg = "The request to connect to and log on to an FTP server failed."
Case ERROR_INTERNET_INVALID_OPERATION ' 12016
sMsg = "The requested operation is invalid."
Case ERROR_INTERNET_OPERATION_CANCELLED ' 12017
sMsg = "The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed."
Case ERROR_INTERNET_INCORRECT_HANDLE_TYPE ' 12018
sMsg = "The type of handle supplied is incorrect for this operation."
Case ERROR_INTERNET_INCORRECT_HANDLE_STATE ' 12019
sMsg = "The requested operation cannot be carried out because the handle supplied is not in the correct state."
Case ERROR_INTERNET_NOT_PROXY_REQUEST ' 12020
sMsg = "The request cannot be made via a proxy."
Case ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND ' 12021
sMsg = "A required registry value could not be located."
Case ERROR_INTERNET_BAD_REGISTRY_PARAMETER ' 12022
sMsg = "A required registry value was located but is an incorrect type or has an invalid value."
Case ERROR_INTERNET_NO_DIRECT_ACCESS ' 12023
sMsg = "Direct network access cannot be made at this time."
Case ERROR_INTERNET_NO_CONTEXT ' 12024
sMsg = "An asynchronous request could not be made because a zero context value was supplied."
Case ERROR_INTERNET_NO_CALLBACK ' 12025
sMsg = "An asynchronous request could not be made because a callback function has not been set."
Case ERROR_INTERNET_REQUEST_PENDING ' 12026
sMsg = "The required operation could not be completed because one or more requests are pending."
Case ERROR_INTERNET_INCORRECT_FORMAT ' 12027
sMsg = "The format of the request is invalid."
Case ERROR_INTERNET_ITEM_NOT_FOUND ' 12028
sMsg = "The requested item could not be located."
Case ERROR_INTERNET_CANNOT_CONNECT ' 12029
sMsg = "The attempt to connect to the server failed."
Case ERROR_INTERNET_CONNECTION_ABORTED ' 12030
sMsg = "The connection with the server has been terminated."
Case ERROR_INTERNET_CONNECTION_RESET ' 12031
sMsg = "The connection with the server has been reset."
Case ERROR_INTERNET_FORCE_RETRY ' 12032
sMsg = "Calls for the Win32 Internet function to redo the request."
Case ERROR_INTERNET_INVALID_PROXY_REQUEST ' 12033
sMsg = "Invalid Proxy request"
Case ERROR_INTERNET_HANDLE_EXISTS ' 12036
sMsg = "The request failed because the handle already exists."
Case ERROR_INTERNET_SEC_CERT_DATE_INVALID ' 12037
sMsg = "Security certifcate date is invalid"
Case ERROR_INTERNET_SEC_CERT_CN_INVALID ' 12038
sMsg = "Security certifcate CN is invalid"
Case ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR ' 12039
sMsg = "HTTP to HTTPS on redirect"
Case ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR ' 12040
sMsg = "HTTPS to HTTP on redirect"
Case ERROR_INTERNET_MIXED_SECURITY ' 12041
sMsg = "Indicates that the content is not entirely secure. Some of the content being viewed may have come from unsecured servers."
Case ERROR_INTERNET_CHG_POST_IS_NON_SECURE ' 12042
sMsg = "Change posting is non-secure"
Case ERROR_INTERNET_POST_IS_NON_SECURE ' 12043
sMsg = "Post is non-secure"
Case ERROR_FTP_TRANSFER_IN_PROGRESS ' 12110
sMsg = "The requested operation cannot be made on the FTP session handle because an operation is already in progress."
Case ERROR_FTP_DROPPED ' 12111
sMsg = "The FTP operation was not completed because the session was aborted."
Case ERROR_GOPHER_PROTOCOL_ERROR ' 12130
sMsg = "An error was detected while parsing data returned from the gopher server."
Case ERROR_GOPHER_NOT_FILE ' 12131
sMsg = "The request must be made for a file locator."
Case ERROR_GOPHER_DATA_ERROR ' 12132
sMsg = "An error was detected while receiving data from the gopher server."
Case ERROR_GOPHER_END_OF_DATA ' 12133
sMsg = "The end of the data has been reached."
Case ERROR_GOPHER_INVALID_LOCATOR ' 12134
sMsg = "The supplied locator is not valid."
Case ERROR_GOPHER_INCORRECT_LOCATOR_TYPE ' 12135
sMsg = "The type of the locator is not correct for this operation."
Case ERROR_GOPHER_NOT_GOPHER_PLUS ' 12136
sMsg = "The requested operation can only be made against a Gopher+ server or with a locator that specifies a Gopher+ operation."
Case ERROR_GOPHER_ATTRIBUTE_NOT_FOUND ' 12137
sMsg = "The requested attribute could not be located."
Case ERROR_GOPHER_UNKNOWN_LOCATOR ' 12138
sMsg = "The locator type is unknown."
Case ERROR_HTTP_HEADER_NOT_FOUND ' 12150
sMsg = "The requested header could not be located."
Case ERROR_HTTP_DOWNLEVEL_SERVER ' 12151
sMsg = "The server did not return any headers."
Case ERROR_HTTP_INVALID_SERVER_RESPONSE ' 12152
sMsg = "The server response could not be parsed."
Case ERROR_HTTP_INVALID_HEADER ' 12153
sMsg = "The supplied header is invalid."
Case ERROR_HTTP_INVALID_QUERY_REQUEST ' 12154
sMsg = "The request made to HttpQueryInfo is invalid."
Case ERROR_HTTP_HEADER_ALREADY_EXISTS ' 12155
sMsg = "The header could not be added because it already exists."
Case ERROR_HTTP_REDIRECT_FAILED ' 12156
sMsg = "HTTP redirect failed"
Case Else
sMsg = "Unknown error number " & dError
End Select
InternetErrorMessage = sMsg
End Function
Function ErrorMessage(dError As Long) As String
Dim lIntError As Long
Dim lLength As Long
Dim sBuffer As String
If dError = ERROR_INTERNET_EXTENDED_ERROR Then
InternetGetLastResponseInfo lIntError, vbNullString, lLength
sBuffer = String(lLength + 1, 0)
InternetGetLastResponseInfo lIntError, sBuffer, lLength
ErrorMessage = lIntError & " " & sBuffer
Else
If Err >= ERROR_INTERNET_FIRST_ERROR And _
Err <= ERROR_INTERNET_LAST_ERROR Then
sBuffer = InternetErrorMessage(dError)
Else
' if it is not an internet-related error, we should
' already have a description in err.description, so
' use it.
sBuffer = Err.Description
End If
' just in case we didn't get a description, let's at least
' return the error number to the user.
If sBuffer = "" Then
ErrorMessage = "Error number " & dError & " occurred."
Else
ErrorMessage = sBuffer
End If
End If
End Function
Private Sub Class_Initialize()
' default the FTP transfer buffer size to 2048
BufferSize = 2048
End Sub
Public Sub DownloadWithStatus()
Dim bRet As Boolean
Dim sFileRemote As String
Dim sDirRemote As String
Dim sFileLocal As String ' the local filename
Dim lDataType As Long ' data type to transfer the file with binary/ascii
Dim lPos As Long
On Error GoTo Handler
'
' Do some data validation on the source filename and
' the destination filename
'
If SourceFilename = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a source filename, such as /public/filename.zip"
End If
If Trim$(DestinationFilename) = "" Then
Err.Raise 5, "cInternet.DownloadFile", _
"You must specify a filename to store the downloaded data, such as c:\download\filename.zip"
End If
'
' try to connect to server. If we can't connect, raise an error.
'
ConnectToServer
' break apart filename for passing to the FtpGetFile call
' we need to do this because the FtpGetFile call will not
' automatically change the directory on the ftp server. So,
' we first have to determine the directory and then do a
' remote change directory call to position the ftp server
' to the correct place. After this, we can successfully
' transfer the file.s
sFileRemote = SourceFilename
lPos = FindLastOccurrence(sFileRemote, "/")
sDirRemote = Left(sFileRemote, lPos)
sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
sFileLocal = DestinationFilename
' change remote directory to sDirRemote
RemoteChangeDir sDirRemote
' set the data transfer mode
If BinaryMode Then
lDataType = FTP_TRANSFER_TYPE_BINARY
Else
lDataType = FTP_TRANSFER_TYPE_ASCII
End If
Dim sData As String ' to get data from the net
Dim lNumberOfBytesRead As Long ' number of bytes read by the InternetReadFile routine
Dim curTotalBytes As Currency ' total number of bytes read for this call
Dim hFile As Long ' file handle to use in InternetReadFile
' this is a pointer to the remote file
Dim curFileSize As Currency ' to hold the filesize of the file about to
' be transferred
' retrieve the file size if possible, returns -1 if it can not be
' determined
curFileSize = FileSize
' open file and force it to be loaded from the network, even if it is
' already cached.
hFile = FtpOpenFile(mhConnection, SourceFilename, GENERIC_READ, _
lDataType Or INTERNET_FLAG_RELOAD, vbNull)
' init our counter and buffer
curTotalBytes = 0
sData = String(BufferSize, " ")
' loop until there is no more data to be read
Do
bRet = InternetReadFile(hFile, sData, BufferSize, _
lNumberOfBytesRead)
RaiseEvent TransferProgress(lNumberOfBytesRead, curTotalBytes, curFileSize)
curTotalBytes = curTotalBytes + lNumberOfBytesRead
Loop Until lNumberOfBytesRead = 0
RaiseEvent TransferComplete(curTotalBytes)
' close of file handle for FTP file
InternetCloseHandle hFile
If bRet Then
DisconnectFromServer
TerminateSession
Else
Err.Raise Err.LastDllError, "FtpGetFile", ErrorMessage(Err.LastDllError)
End If
Exit Sub
Handler:
If Err Then
Err.Raise 5, "DownloadFile", "Trying to download file from " & ServerName & "." & vbCrLf & vbCrLf & "Error Message: " & Err.Description
Exit Sub
End If
Err.Raise Err.Number, "OneStepDownload", Err.Description
End Sub
'
' We use currency as a workaround to the lack of a large integer in Visual
' Basic. The Currency data type has the range of –922,337,203,685,477.5808
' to 922,337,203,685,477.5807. This should handle any size file for at least
' the next couple of years