Visual Basic Code of the Week (COTW)
http://www.codeoftheweek.com
Issue #54
Online Version at http://www.codeoftheweek.com/membersonly/bi/0054.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

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.

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

In this Issue

This issue shows how to use the Microsoft WININET.DLL to retrieve a file from an FTP server. 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 next issue or two. 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 four properties and call one method. The additional properties of this class will be discussed in the next issue. We've included the basics to get you started.

Property Definitions

Public ServerName As String
Public SourceFilename As String
Public DestinationFilename As String
Public BinaryMode As Boolean

Method Definitions

Public Sub OneStepDownload()

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.

Sample Usage

    Private Sub cmdDownload_Click()
        Dim ftp As New cFTP

        On Error GoTo Handler
        ftp.ServerName = "www.microsoft.com"
        ftp.SourceFilename = "/pub/testfile.exe"
        ftp.DestinationFilename = "c:\test.exe"
        ftp.BinaryMode = True
        ftp.OneStepDownload
        Exit Sub

    Handler:
        MsgBox Err.Description
    End Sub

Source Code

Just paste this source code into a module called basDates 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

'
'   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

'
' 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


' 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


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


'   No more handles could be generated at this time.
Private Const ERROR_INTERNET_OUT_OF_HANDLES = 12001
'   The request has timed out.
Private Const ERROR_INTERNET_TIMEOUT = 12002
'   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.
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003
'   An internal error has occurred.
Private Const ERROR_INTERNET_INTERNAL_ERROR = 12004
'   The URL is invalid.
Private Const ERROR_INTERNET_INVALID_URL = 12005
'   The URL scheme could not be recognized or is not supported.
Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = 12006
'   The server name could not be resolved.
Private Const ERROR_INTERNET_NAME_NOT_RESOLVED = 12007
'   The requested protocol could not be located.
Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = 12008
'   A request to InternetQueryOption or InternetSetOption specified an invalid option value.
Private Const ERROR_INTERNET_INVALID_OPTION = 12009
'   The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified.
Private Const ERROR_INTERNET_BAD_OPTION_LENGTH = 12010
'   The request option cannot be set, only queried.
Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE = 12011
'   The Win32 Internet function support is being shut down or unloaded.
Private Const ERROR_INTERNET_SHUTDOWN = 12012
'   The request to connect and log on to an FTP server could not be completed because the supplied user name is incorrect.
Private Const ERROR_INTERNET_INCORRECT_USER_NAME = 12013
'   The request to connect and log on to an FTP server could not be completed because the supplied password is incorrect.
Private Const ERROR_INTERNET_INCORRECT_PASSWORD = 12014
'   The request to connect to and log on to an FTP server failed.
Private Const ERROR_INTERNET_LOGIN_FAILURE = 12015
'   The requested operation is invalid.
Private Const ERROR_INTERNET_INVALID_OPERATION = 12016
'   The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed.
Private Const ERROR_INTERNET_OPERATION_CANCELLED = 12017
'   The type of handle supplied is incorrect for this operation.
Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = 12018
'   The requested operation cannot be carried out because the handle supplied is not in the correct state.
Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = 12019
'   The request cannot be made via a proxy.
Private Const ERROR_INTERNET_NOT_PROXY_REQUEST = 12020
'   A required registry value could not be located.
Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = 12021
'   A required registry value was located but is an incorrect type or has an invalid value.
Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = 12022
'   Direct network access cannot be made at this time.
Private Const ERROR_INTERNET_NO_DIRECT_ACCESS = 12023
'   An asynchronous request could not be made because a zero context value was supplied.
Private Const ERROR_INTERNET_NO_CONTEXT = 12024
'   An asynchronous request could not be made because a callback function has not been set.
Private Const ERROR_INTERNET_NO_CALLBACK = 12025
'   The required operation could not be completed because one or more requests are pending.
Private Const ERROR_INTERNET_REQUEST_PENDING = 12026
'   The format of the request is invalid.
Private Const ERROR_INTERNET_INCORRECT_FORMAT = 12027
'   The requested item could not be located.
Private Const ERROR_INTERNET_ITEM_NOT_FOUND = 12028
'   The attempt to connect to the server failed.
Private Const ERROR_INTERNET_CANNOT_CONNECT = 12029
'   The connection with the server has been terminated.
Private Const ERROR_INTERNET_CONNECTION_ABORTED = 12030
'   The connection with the server has been reset.
Private Const ERROR_INTERNET_CONNECTION_RESET = 12031
'   Calls for the Win32 Internet function to redo the request.
Private Const ERROR_INTERNET_FORCE_RETRY = 12032
'   Invalid Proxy request
Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST = 12033
'   The request failed because the handle already exists.
Private Const ERROR_INTERNET_HANDLE_EXISTS = 12036
'   Security certifcate date is invalid
Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = 12037
'   Security certifcate CN is invalid
Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID = 12038
'   HTTP to HTTPS on redirect
Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = 12039
'   HTTPS to HTTP on redirect
Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = 12040
'   Indicates that the content is not entirely secure. Some of the content being viewed may have come from unsecured servers.
Private Const ERROR_INTERNET_MIXED_SECURITY = 12041
'   Change posting is non-secure
Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = 12042
'   Post is non-secure
Private Const ERROR_INTERNET_POST_IS_NON_SECURE = 12043
'   The requested operation cannot be made on the FTP session handle because an operation is already in progress.
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS = 12110
'   The FTP operation was not completed because the session was aborted.
Private Const ERROR_FTP_DROPPED = 12111
'   An error was detected while parsing data returned from the gopher server.
Private Const ERROR_GOPHER_PROTOCOL_ERROR = 12130
'   The request must be made for a file locator.
Private Const ERROR_GOPHER_NOT_FILE = 12131
'   An error was detected while receiving data from the gopher server.
Private Const ERROR_GOPHER_DATA_ERROR = 12132
'   The end of the data has been reached.
Private Const ERROR_GOPHER_END_OF_DATA = 12133
'   The supplied locator is not valid.
Private Const ERROR_GOPHER_INVALID_LOCATOR = 12134
'   The type of the locator is not correct for this operation.
Private Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE = 12135
'   The requested operation can only be made against a Gopher+ server or with a locator that specifies a Gopher+ operation.
Private Const ERROR_GOPHER_NOT_GOPHER_PLUS = 12136
'   The requested attribute could not be located.
Private Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND = 12137
'   The locator type is unknown.
Private Const ERROR_GOPHER_UNKNOWN_LOCATOR = 12138
'   The requested header could not be located.
Private Const ERROR_HTTP_HEADER_NOT_FOUND = 12150
'   The server did not return any headers.
Private Const ERROR_HTTP_DOWNLEVEL_SERVER = 12151
'   The server response could not be parsed.
Private Const ERROR_HTTP_INVALID_SERVER_RESPONSE = 12152
'   The supplied header is invalid.
Private Const ERROR_HTTP_INVALID_HEADER = 12153
'   The request made to HttpQueryInfo is invalid.
Private Const ERROR_HTTP_INVALID_QUERY_REQUEST = 12154
'   The header could not be added because it already exists.
Private Const ERROR_HTTP_HEADER_ALREADY_EXISTS = 12155
'   HTTP redirect failed
Private Const ERROR_HTTP_REDIRECT_FAILED = 12156

'
'   Public variables
'
Public ProxyServer As String
Public ServerName As String
Public SourceFilename As String
Public DestinationFilename As String
Public Username As String
Public Password As String
Public PassiveMode As Boolean
Public BinaryMode As Boolean

Dim mhOpen As Long
Dim mhConnection As Long

Public Sub InitSession()
    If Len(ProxyServer) <> 0 Then
        mhOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, ProxyServer, vbNullString, 0)
    Else
        mhOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    End If
    If mhOpen = 0 Then
        Err.Raise Err.LastDllError, "InitSession", ErrorMessage(Err.LastDllError)
    End If
End Sub

Public Sub ConnectToServer()
    Dim lFlag As Long

    If mhOpen = 0 Then
        On Error Resume Next
        InitSession
        If Err Then
            Err.Raise Err.Number, "ConnectToServer", Err.Description
        End If
    End If

    If PassiveMode Then
        lFlag = INTERNET_FLAG_PASSIVE
    Else
        lFlag = 0
    End If

    mhConnection = InternetConnect(mhOpen, 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
End Sub

Public Sub DisconnectFromServer()
    If mhConnection <> 0 Then
        Call InternetCloseHandle(mhConnection)
        mhConnection = 0
    End If
End Sub

Public Sub TerminateSession()
    If mhOpen <> 0 Then
        Call InternetCloseHandle(mhOpen)
        mhOpen = 0
    End If
End Sub

Public Sub OneStepDownload()
    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 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
        ' we will include better error handling in the next issue.
        ErrorMessage = "Error number " & dError & " occurred."
    End If
End Function

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.

Summary

That concludes this issue of COTW. We hope you find the source code useful in your development.

The below describes the ways you can supply us some feedback about COTW. We would like to see our members help mold COTW into the best Visual Basic source code resource available. But to do that we need your feedback about what you like and what you do not like about COTW.

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