Visual Basic Code of the Week (COTW)
http://www.codeoftheweek.com
Issue #56
Online Version at http://www.codeoftheweek.com/membersonly/bi/0056.html (paid subscribers only)
All content and source code is Copyright (c) 1998 by C&D Programming Corp. No part of this issue can be reprinted or distributed in any manner without express written permission of C&D Programming Corp.

Notes about this ezine

All source code is available in this email below, you do not need to access the web site to obtain the source code.

If you are not a paid subscriber, you must have signed up for our free trial at http://www.codeoftheweek.com. Our ezine is not an unsolicited message (in other words a spam email). Keep in mind that if you signed up for our free trial you can still receive a total of four issues at no cost to you. After you receive the four issues you will be notified about continuing your subscription.

If you do not wish to continue to receive this ezine, please email us at cancel@codeoftheweek.com

Requirements for this Issue

The source code in this issue is designed for Visual Basic 4.0 32-bit and above. It also requires the source code from issue #55 of Code of the Week.

If you have any questions about this issue, please email us at questions@codeoftheweek.com

In this Issue

This issue enhances the code introduced in issue number 54. It shows how to use the Microsoft WININET.DLL to retrieve a file from an FTP server. This version of cFTP provides a couple of events to return the transfer progress. It does not use the Microsoft Internet Controls, so there is one less file you have to worry about including with your application.

cFTP class

This class allows you to download a file from an FTP server very easily. We will be enhancing this class in the future with the ability to upload a file. If you have specific requests, please get them to us as soon as possible at requests@codeoftheweek.com

Basically to use this class you need to set a few properties and call one method.

Property Definitions

Public ServerName As String
Public SourceFilename As String
Public DestinationFilename As String
Public BinaryMode As Boolean
Public BufferSize As Long
Public ProxyServer As String

Method Definitions

Public Sub DownloadWithStatus()

This is the method that actually connects to the server, changes to the appropriate directory and downloads a file. It will raise some errors if necessary, such as if the server can not be connected to or the file can not be found.

Events

Public Event TransferProgress(lBytesRead As Long, _
                                curTotalBytes As Currency, _
                                curFileSize As Currency)
Public Event TransferComplete(curTotalBytes As Currency)

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). You will probably never FTP a 2 gigabyte file, but if you do this class will handle it correctly.

The TransferProgress event is fired periodically as the file is being transferred. It passes the number of bytes read in the last chunk of data (this will usually equal the BufferSize property), the number of bytes read so far, and the total bytes in the file being transferred (-1 if it was not able to determine that information). It provides enough information to show a progress bar or status information to the end user.

When the transfer is completed the TransferComplete event will be fired with the total number of bytes transferred as its sole parameter.

Sample Usage

This example assumes you pasted this into a form that contains the following controls: txtServerName, txtSourceFile, txtDestFile as TextBox; optMode(0) and optMode(1) for selecting ASCII transfer or Binary Transfer as Option buttons, bar as ProgressBar, and lblStatus as Label. This sample will download the file entered in txtSourceFile from txtServerName and place it into txtDestFile. It will update a progress bar and a status label with the transfer progress.

This sample uses the SmartNumberFormat routine found in issue number 52 of Code of the Week.

Option Explicit

Dim WithEvents oFTP As cFTP    ' Need to declare this WithEvents so we get notified of events.

Private Sub oFTP_TransferComplete(curTotalBytes As Currency)
    lblStatus.Caption = "Transfer completed.  Transferred " & SmartNumberFormat(CDbl(curTotalBytes), fsd_Bytes) & " bytes"
End Sub

Private Sub oFTP_TransferProgress(lBytesRead As Long, _
                                    curTotalBytes As Currency, _
                                    curFileSize As Currency)
    If curFileSize <> -1 Then
        bar.Min = 0
        bar.Max = curFileSize
        bar.Value = curTotalBytes
        lblStatus = SmartNumberFormat(CDbl(curTotalBytes)) & " transferred so far of " & SmartNumberFormat(CDbl(curFileSize))
    Else
        lblStatus = curTotalBytes
    End If
    lblStatus.Refresh
End Sub

Private Sub cmdDownload_Click()

    On Error GoTo Handler
    ' created this way since we use the WithEvents keyword
    Set oFTP = New cFTP
    oFTP.ServerName = txtServerName
    oFTP.SourceFilename = txtSourceFile
    oFTP.DestinationFilename = txtDestFile
    oFTP.BinaryMode = optMode(1).Value
    oFTP.DownloadWithStatus
    Exit Sub

Handler:
    MsgBox Err.Description
End Sub

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

This document is available on the web

Paid subscribers can view this issue in HTML format. There is no additional source or information in the HTML formatted document. It just looks a little better since we have included some HTML formatting. Just point your browser to link at the top of this document.

Advertising

If you are interested in advertising in COTW please email us at sponsor@codeoftheweek.com Our rates are VERY reasonable, actually they are almost FREE. We reach over five thousand Visual Basic developers each week.

How to tell us what you think

If you have any suggestions for topics you would like to see covered or questions about this issue, please email them to info@codeoftheweek.com or use online feedback form at http://www.codeoftheweek.com/feedback.html.

If you have any source code you would like to submit for possible inclusion in COTW, please fill out our online submission form at http://www.codeoftheweek.com/submission.html.

Contact Information

C&D Programming Corp.
PO Box 20128
Floral Park, NY 11002-0128
Phone or Fax: (212) 504-7945
Email: info@codeoftheweek.com
Web: http://www.codeoftheweek.com

Subscription Update

Thank you for trying Code of the Week for Visual Basic.

Your free trial expires after you receive your fourth issue. If you want to continue to receive Code of the Week you can get 52 issues of COTW for only $19.95. This is a full year of Visual Basic source code and information to help with all your development. So don't wait, subscribe now! The quickest way to subscribe is to jump to our online order form at http://www.codeoftheweek.com/order.html