Source code for Issue Number 56

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home


Source Code

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 
'
Public Property Get FileSize() As Currency
    Dim lLastError As Long      ' remembers the last DLL error

    Dim hFind As Long           ' handle used to retrieve data
    Dim pFileData As WIN32_FIND_DATA    ' file data that will be retrieved

    Dim sFileRemote As String   ' name of the remote filename
    Dim sDirRemote As String    ' name of the remote directory
    Dim lPos As Long            ' temp var used for positioning

    On Error GoTo Handler

    ' if already connected it will use the existing connection otherwise
    ' it will create the connection
    ConnectToServer

    sDirRemote = ""
    sFileRemote = SourceFilename
    If InStr(sFileRemote, "/") > 0 Then
        ' break apart filename if there seems to be a path in it.
        lPos = FindLastOccurrence(sFileRemote, "/")
        sDirRemote = Left(sFileRemote, lPos)
        sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
        ' change remote directory to sDirRemote
        RemoteChangeDir sDirRemote
    End If

    ' init filename for returning and then call function to try to
    ' find the file.
    pFileData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindFirstFile(mhConnection, sFileRemote, pFileData, 0, 0)
    lLastError = Err.LastDllError

    ' if an error occurred getting the file (could mean the file does not
    ' exist).
    If hFind = 0 Then
        If (lLastError = ERROR_NO_MORE_FILES) Then
            ' file does not exit, so make the size 0
            FileSize = -1
        Else
            Err.Raise 5, "FileSize", ErrorMessage(lLastError)
        End If
        Exit Property
    Else
        ' the data returned in FtpFindFirstFile contains the file size in
        ' two long values (to allow for files larger than 2 gigabytes).
        ' This calculation will support extremely large files correctly.
        ' 2 ^ 32 (4294967296@) is the maximum value for a 4 byte unsigned
        ' integer
        FileSize = CCur(pFileData.nFileSizeHigh) * CCur(2 ^ 32) + CCur(pFileData.nFileSizeLow)
    End If

    ' we are done with the file search, so close the handle we used.
    InternetCloseHandle hFind
    Exit Property

Handler:
    If Err Then
        Err.Raise 5, "FileSize", "Trying to determine file size on " & ServerName & " for file " & SourceFilename & "." & vbCrLf & vbCrLf & "Error Message: " & Err.Description
        Exit Property
    End If
    Err.Raise Err.Number, "FileSize", Err.Description
End Property