access 97 vba code for modem connection

[itpro420]

In Access 97, I have created a form where the user enters the ftp site name, a login name, the password (optional), and selects the files to be ftp'd. Then she/he would click the send button that builds the ftp command file, connects to the ISP, and executes the ftp command passing the file created as the argument: "ftp -s:ftp.txt". I've got everything working just fine except the user has to connect to the ISP outside the app before clicking the "Send" button.

In C++, this connection can be made using the CInternetSession and CFtpConection classes. Is there something similar in VBA?

Ted

 

[itpro420]

I didn't get any response from this forum to my question, nor from the microsoft.public.access.modulesdaovba news group. So I did what we all hate to do: researched it myself and came up with my own solution. Just in case there are some of you who want to do this, too (FTP connections from within Access), here is the code I developed for my Access 97 application. Hope you find it useful.

In the clsFtpControl class module, there are four constants you will need to change to suit your needs:

Private Const MC_FTPSERVER As String = "ftp://someserver"
Private Const MC_FTPLOGIN As String = "loginid"
Private Const MC_FTPPWD As String = "password"
Private Const MC_FTPAGENT As String = "clsFtpControl"

Any comments or suggestions are appreciated.

Ted

http://www.myownitpro.com

----------------------------------------------------------

Attribute VB_Name = "modPublic_Const_For_clsFtpControl"
Option Compare Database
Option Explicit

Private Const MODULE_NAME As String = _
    "modPublic_Const_For_clsFtpControl"

'* COPYRIGHT NOTICE ***************************************************
'* These flags were taken from wininet.h, used in C++ for wininet.dll.*
'* They have been modified as needed for use by VB/VBA.  Since these  *
'* are "public" information from Microsoft, I cannot copyright them!  *
'* But I would appreciate being acknowledged as the author of this    *
'* standard module and the companion class module, clsFtpControl.     *
'* There is nothing unique or new here, but a lot of time and effort  *
'* went into making  this work properly!                              *
'*                                                                    *
'* Copyright (C) 2003, Theodore C. Saari. All Rights Reserved.        *
'* This standard module and it's companion class module,              *
'* clsFtpControl, may be used for non-commercial, private use without *
'* fee or license as long as this copyright notice is maintained      *
'* without modification.  All other use requires written permission   *
'* from the author:                                                   *
'*    Theodore C. Saari                                               *
'*    7917 Orchard Ave N                                              *
'*    Brooklyn Park, MN 55443-2414                                    *
'*    [URL unfurl="true"]www.myownitpro.com[/URL]                                              *
'*                                                                    *
'**********************************************************************

' m_intServerPort for InternetConnect()
Public Const INTERNET_DEFAULT_FTP_PORT = 21   'Uses the default port
     'for FTP servers (port 21)
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70 'Uses the default port
     'for Gopher servers (port 70)
Public Const INTERNET_DEFAULT_HTTP_PORT = 80 'Uses the default port
    'for HTTP servers (port 80)
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443 'Uses the default port
    'for Secure Hypertext Transfer Protocol (HTTPS) servers (port 443)
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080 'Uses the default
    'port for SOCKS firewall servers (port 1080)
Public Const INTERNET_INVALID_PORT_NUMBER = 0 'Uses the default port
    'for the service specified by lngService

' service types for InternetConnect()
Public Const INTERNET_SERVICE_URL = 0
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

'        1         2        3        4        5        6        7
'2345678901234567890234567890234567890234567890234567890234567890123456
Public Const INTERNET_FLAG_PASSIVE = 134217728 'CLng(&H8000000)
    'used for FTP connections

Public Const FTP_TRANSFER_TYPE_UNKNOWN = 0
Public Const FTP_TRANSFER_TYPE_ASCII = 1   'CLng(&H1)
Public Const FTP_TRANSFER_TYPE_BINARY = 2  'CLng(&H2)


---------------------------------------------------------

Attribute VB_Name = "clsFtpControl"
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

Private Const MODULE_NAME As String = "clsFtpControl"

'* COPYRIGHT NOTICE ***************************************************
'* These constants, declarations, and functions were taken from       *
'* wininet.h, used in C++ for wininet.dll.                            *
'*                                                                    *
'* They have been modified as needed for use by VB/VBA.  Since these  *
'* are "public" information from Microsoft, I cannot copyright them!  *
'* But I would appreciate being acknowledged as the author of this    *
'* standard module and the companion standard module,                 *
'* modPublic_Const_For_clsFtpControl.                                 *
'*                                                                    *
'* There is nothing unique or new here, but a lot of time and effort  *
'* went into making  this work properly!                              *
'*                                                                    *
'* Copyright (C) 2003, Theodore C. Saari. All Rights Reserved.        *
'* This standard module and it's companion class module,              *
'* clsFtpControl, may be used for non-commercial, private use without *
'* fee or license as long as this copyright notice is maintained      *
'* without modification.  All other use requires written permission   *
'* from the author:                                                   *
'*    Theodore C. Saari                                               *
'*    7917 Orchard Ave N                                              *
'*    Brooklyn Park, MN 55443-2414                                    *
'*    [URL unfurl="true"]www.myownitpro.com[/URL]                                              *
'*                                                                    *
'**********************************************************************

'* From wininet.h #defines ********************************************
' maximum field lengths (arbitrary)
Private Const INTERNET_MAX_HOST_NAME_LENGTH = 256
Private Const INTERNET_MAX_USER_NAME_LENGTH = 128
Private Const INTERNET_MAX_PASSWORD_LENGTH = 128
Private Const INTERNET_MAX_PORT_NUMBER_LENGTH = 5
Private Const INTERNET_MAX_PORT_NUMBER_VALUE = 65535
Private Const INTERNET_MAX_PATH_LENGTH = 2048
Private Const INTERNET_MAX_SCHEME_LENGTH = 32 'longest protocol
    'name length
Private Const INTERNET_MAX_URL_LENGTH = INTERNET_MAX_SCHEME_LENGTH _
    + 3 _
    + INTERNET_MAX_PATH_LENGTH 'sizeof("://") = 3
    
Private Const INTERNET_FLAG_TRANSFER_ASCII = FTP_TRANSFER_TYPE_ASCII
    ' &H00000001
Private Const INTERNET_FLAG_TRANSFER_BINARY = FTP_TRANSFER_TYPE_BINARY
    ' &H00000002

' INTERNET_NO_CALLBACK - if this value is presented as the lngContext
' parameter then no call-backs will be made for that API
Private Const INTERNET_NO_CALLBACK = 0

' access types for InternetOpen()
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
    ' use registry configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
    ' direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3
    ' via named proxy
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
    ' prevent using java/script/INS

Private Const INTERNET_FLAG_ASYNC = 268435456   ' CLng(&H10000000)
    ' this request is asynchronous (where supported)
Private Const INTERNET_FLAG_FROM_CACHE = 16777216   ' CLng(&H1000000)
    ' use offline semantics
Private Const INTERNET_FLAG_OFFLINE = INTERNET_FLAG_FROM_CACHE

Private Const FILE_ATTRIBUTE_ARCHIVE = 32               'CLng(&H20)
Private Const FILE_ATTRIBUTE_ENCRYPTED = 64             'CLng(&H40)
Private Const FILE_ATTRIBUTE_HIDDEN = 2                 'CLng(&H2)
Private Const FILE_ATTRIBUTE_NORMAL = 128               'CLng(&H80)
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 8192 'CLng(&H2000)
Private Const FILE_ATTRIBUTE_OFFLINE = 4096             'CLng(&H1000)
Private Const FILE_ATTRIBUTE_READONLY = 1               'CLng(&H1)
Private Const FILE_ATTRIBUTE_SYSTEM = 4                 'CLng(&H4)
Private Const FILE_ATTRIBUTE_TEMPORARY = 256            'CLng(&H100)
Private Const FILE_ATTRIBUTE_COMPRESSED = 2048          'CLng(&H800)
Private Const FILE_ATTRIBUTE_DIRECTORY = 16             'CLng(&H10)
Private Const FILE_ATTRIBUTE_REPARSE_POINT = 1024       'CLng(&H400)
Private Const FILE_ATTRIBUTE_SPARSE_FILE = 512          'CLng(&H200)
Private Const MAXDWORD As Double = 4294967280#        'CDbl(&HFFFFFFFF)
'* End of wininet.h #defines ******************************************

'* Module constants ***************************************************
Private Const MC_ERROR_NO_MORE_FILES As Long = 18

'InternetOpen constants
Private Const MC_FTPSERVER As String = "ftp://someserver"
Private Const MC_FTPLOGIN As String = "loginid"
Private Const MC_FTPPWD As String = "password"
Private Const MC_FTPAGENT As String = "clsFtpControl"

Private Const MC_INTERNET_PROXY_NAME_DEFAULT As String = vbNullString
Private Const MC_INTERNET_PROXY_BYPASS_DEFAULT As String = vbNullString
Private Const MC_INTERNET_FLAG_NONE As Long = 0
Private Const MC_FILE_ATTRIBUTE_NONE As Long = 0

'user cannot access these
Private m_hInternetConnection As Long
Private m_hInernetSession As Long
Private m_lngInternetOpenFlags As Long
Private m_lngInternetService As Long
Private m_lngInternetConnectFlag As Long
Private m_lngInternetCallbackFlag As Long
Private m_lngFtpFindFirsFileFlag As Long
Private m_intServerPort As Integer

' Public Property routines for these
Private m_strAgent As String            'FtpAgent Property
Private m_strPassword As String         'FtpPwd Property
Private m_strServerName As String       'FtpServerName
Private m_strLoginName As String        'FtpLoginName
Private m_lngAccessType As Long         'FtpAccessType
Private m_strProxyName As String        'FtpProxyName
Private m_strProxyBypass As String      'FtpProxyBypass
Private m_fFailExists As Boolean        'FtpFailGetIfFileExists
Private m_lngFlagsAndAttributes As Long 'FtpFileFlagsAndAttributes

Private Declare Function InternetOpen Lib "wininet.dll" _
    Alias "InternetOpenA" _
    (ByVal strAgent As String, _
    ByVal lngAccessType As Long, _
    ByVal strProxyName As String, _
    ByVal strProxyBypass As String, _
    ByVal lngFlags As Long) As Long
    'strAgent: string that specifies the name of the application or
    ' entity calling the WinINet functions. This name is used as the
    ' user agent in the HTTP protocol.
    'lngAccessType: Type of access required. This parameter can be one
    '  of the following values.
    '  Value                           Meaning
    '  INTERNET_OPEN_TYPE_DIRECT       Resolves all host names locally.
    '  INTERNET_OPEN_TYPE_PRECONFIG    Retrieves the proxy or direct
    '   configuration from the registry.
    '  INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY
    '   Retrieves the proxy or direct configuration from the registry
    '   and prevents the use of a startup Microsoft® JScript® or
    '   Internet Setup (INS) file.
    '  INTERNET_OPEN_TYPE_PROXY        Passes requests to the proxy
    '   unless a proxy bypass list is supplied and the name to be
    '   resolved bypasses the proxy. In this case, the function uses
    '   INTERNET_OPEN_TYPE_DIRECT.
    '   NOTE: The lngAccessTypespecifies whether we connect directly
    '   to a host or whether we use a proxy server for the connection.
    '   If we pass the value 1, we’ll connect directly to the host.
    '   If we pass the value 3, we’ll connect via a proxy server. If
    '   we pass 0, we’ll connect based on the registry values
    '   ProxyEnable, ProxyServer, and ProxyOverride located under
    '    HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion _
    '       \Internet Settings
    'strProxyName: string that specifies the name of the proxy
    '   server(s) to use when proxy access is specified by setting
    '   lngAccessType to INTERNET_OPEN_TYPE_PROXY. Do not use an empty
    '   string, because InternetOpen will use it as the proxy name.
    '   The WinINet functions recognize only CERN type proxies (HTTP
    '   only) and the TIS FTP gateway (FTP only). If Microsoft
    '   Internet Explorer is installed, these functions also support
    '   SOCKS proxies. FTP and Gopher requests can be made through a
    '   CERN type proxy either by changing them to an HTTP request or
    '   by using InternetOpenUrl. If lngAccessType is not set to
    '   INTERNET_OPEN_TYPE_PROXY, this parameter is ignored and should
    '   be NULL.
    '
    '   The basic format for listing a proxy is
    '   “protocol=protocol://proxy_name:access_port”.
    '   For example, to specify port 21 on Proxy1 as the proxy server,
    '   use “ftp=ftp://Proxy1:21” as the strProxyName. The default is
    '   NULL so we will use that.
    'strProxyBypass: string that specifies an optional list of host
    '   names or IP addresses, or both, that should not be routed
    '   through the proxy when dwAccessType is set to
    '   INTERNET_OPEN_TYPE_PROXY. The list can contain wildcards. Do
    '   not use an empty string, because InternetOpen will use it as
    '   the proxy bypass list. If lngAccessType is not set to
    '   INTERNET_OPEN_TYPE_PROXY, this parameter is ignored and should
    '   be NULL.
    '
    '   Use this to provide a list of IP addresses or names that should
    '   not be routed to the proxy.  To bypass any host that starts
    '   with “nov”, the strProxyBypass string would be “nov*”. The
    '   default is NULL so we will use that.
    'lngFlags: Options. This parameter can be a combination of the
    '   following values.
    '   Value                       Meaning
    '   INTERNET_FLAG_ASYNC         Makes only asynchronous requests on
    '       handles descended from the handle returned from this
    '       function.
    '   INTERNET_FLAG_FROM_CACHE    Does not make network requests. All
    '       entities are returned from the cache. If the requested item
    '       is not in the cache, a suitable error, such as
    '       ERROR_FILE_NOT_FOUND, is returned.
    '   INTERNET_FLAG_OFFLINE       Identical to
    '       INTERNET_FLAG_FROM_CACHE. Does not make network requests.
    '       All entities are returned from the cache. If the requested
    '       item is not in the cache, a suitable error, such as
    '       ERROR_FILE_NOT_FOUND, is returned.
    '
    '       We’ll pass MC_INTERNET_FLAG_NONE, 0, for no flags.

Private Declare Function InternetConnect Lib "wininet.dll" Alias _
    "InternetConnectA" ( _
    ByVal hInternetSession As Long, _
    ByVal strServerName As String, _
    ByVal intServerPort As Integer, _
    ByVal strUsername As String, _
    ByVal strPassword As String, _
    ByVal lngService As Long, _
    ByVal lngFlags As Long, _
    ByVal lngContext As Long) As Long
    'hInternetSession: Handle returned by a previous call to
    '   InternetOpen.
    'strServerName: string that specifies the host name of an Internet
    '   server. Alternately, the string can contain the IP number of
    '   the site, in ASCII dotted-decimal format (for example,
    '   11.0.1.45).
    'intServerPort: Transmission Control Protocol/Internet Protocol
    '   (TCP/IP) port on the server. These flags set only the port that
    '   is used. The service is set by the value of lngService. This
    '   parameter can be one of the following values.
    '       INTERNET_DEFAULT_FTP_PORT
    '       INTERNET_DEFAULT_GOPHER_PORT
    '       INTERNET_DEFAULT_HTTP_PORT
    '       INTERNET_DEFAULT_HTTPS_PORT
    '       INTERNET_DEFAULT_SOCKS_PORT
    '       INTERNET_INVALID_PORT_NUMBER (If lngService = 1 (Ftp), this
    '           will be Port 21)
    'strUsername: string that specifies the name of the user to log on.
    '   If this parameter is NULL, the function uses an appropriate
    '   default, except for HTTP; a NULL parameter in HTTP causes the
    '   server to return an error. For the FTP protocol, the default
    '   is "anonymous".
    'strPassword: string that contains the password to use to log on.
    '   If both strPassword and strUsername are NULL, the function
    '   uses the default "anonymous" password. In the case of FTP, the
    '   default password is the user's e-mail name. If strPassword is
    '   NULL, but strUsername is not NULL, the function uses a blank
    '   password.
    'lngService Type of service to access. This parameter can be one of
    '   the following values:
    '   INTERNET_SERVICE_FTP    : FTP service.
    '   INTERNET_SERVICE_GOPHER : Gopher service.
    '   INTERNET_SERVICE_HTTP   : HTTP service.
    'lngFlags: Options specific to the service used. If lngService is
    '   INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE causes the
    '   application to use passive FTP semantics. Otherwise, we can
    '   pass 0 to use non-passive semantics.
    'lngContext: application-defined value that is used to identify the
    '   application context for the returned handle in callbacks. We
    '   use INTERNET_NO_CALLBACK since multi-threading is not allowed
    '   in VBA or VB

Private Declare Function FtpGetFile Lib "wininet.dll" Alias _
    "FtpGetFileA" ( _
    ByVal hConnect As Long, _
    ByVal strRemoteFile As String, _
    ByVal strNewFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal lngFlagsAndAttributes As Long, _
    ByVal lngFlags As Long, _
    ByVal lngContext As Long) As Boolean
    'hConnect: Handle to an FTP session.  It is the value of the handle
    '   returned by the InternetConnect call.
    'strRemoteFile: string that contains the name of the file to be
    '   retrieved
    'strNewFile: string that contains the name of the file to be
        'created on the local system
    'fFailIfExists: Indicates whether the function should proceed if a
    '   local file of the specified name already exists. If
    '   fFailIfExists is TRUE and the local file exists, FtpGetFile
    '   fails. Flag is either 0 (False) meaning "replace local file",
    '   or –1 (True) meaning "fail if local file already exists".
    'lngFlagsAndAttributes: File attributes for the new file. This
    '   parameter can be any combination of the FILE_ATTRIBUTE_* flags
    '   used by the C++ CreateFile function. From MS C++ CreateFile
    '   function documentation:
    '    File attributes and flags. (defined in winnt.h)
    '    The following file attributes are used only for file objects,
    '    not other types of objects created by CreateFile. This
    '    parameter can include any combination of the file attributes
    '    (noting that all other file attributes override
    '    FILE_ATTRIBUTE_NORMAL).
    '    Attribute                 Meaning
    '    FILE_ATTRIBUTE_ARCHIVE    The file should be archived.
    '       Applications use this attribute to mark files for backup
    '       or removal.
    '    FILE_ATTRIBUTE_ENCRYPTED  The file or directory is encrypted.
    '       For a file, this means that all data in the file is
    '       encrypted. For a directory, this means that encryption is
    '       the default for newly created files and subdirectories.
    '       For more information, see File Encryption in MSDN, Platform
    '       SDK. This flag has no effect if FILE_ATTRIBUTE_SYSTEM is
    '       also specified.
    '    FILE_ATTRIBUTE_HIDDEN     The file is hidden. It is not to be
    '       included in an ordinary directory listing.
    '    FILE_ATTRIBUTE_NORMAL     The file has no other attributes
    '       set. This attribute is valid only if used alone.
    '    FILE_ATTRIBUTE_NOT_CONTENT_INDEXED The file will not be
    '       indexed by the content indexing service.
    '    FILE_ATTRIBUTE_OFFLINE    The data of the file is not
    '       immediately available. This attribute indicates that the
    '       file data has been physically moved to offline storage.
    '       This attribute is used by Remote Storage, the
    '       hierarchical storage management software. Applications
    '       should not arbitrarily change this attribute.
    '    FILE_ATTRIBUTE_READONLY   The file is read only. Applications
    '       can read the file but cannot write to it or delete it.
    '    FILE_ATTRIBUTE_SYSTEM     The file is part of or is used
    '       exclusively by the operating system.
    '    FILE_ATTRIBUTE_TEMPORARY  The file is being used for temporary
    '       storage. File systems attempt to keep all of the data in
    '       memory for quicker access rather than flushing the data
    '       back to mass storage. A temporary file should be deleted
    '       by the application as soon as it is no longer needed.
    '
    '       We’ll overlook this and just pass
    '       MC_FILE_ATTRIBUTE_NONE (0).
    '
    'lngFlags: Controls how the function will handle the file download.
    '   The first set of flag values indicates the conditions under
    '   which the transfer occurs. These transfer type flags can be
    '   used in combination with the second set of flags that control
    '   caching. The application can select one of these transfer
    '   type values.
    '   Value                       Meaning
    '   FTP_TRANSFER_TYPE_ASCII     Transfers the file using FTP's
    '       ASCII (Type A) transfer method. Control and formatting
    '       information is converted to local equivalents.
    '   FTP_TRANSFER_TYPE_BINARY    Transfers the file using FTP's
    '       Image (Type I) transfer method. The file is transferred
    '       exactly as it exists with no changes. This is the default
    '       transfer method.
    '   FTP_TRANSFER_TYPE_UNKNOWN   Defaults to
    '       FTP_TRANSFER_TYPE_BINARY.
    '   INTERNET_FLAG_TRANSFER_ASCII Transfers the file as ASCII.
    '   INTERNET_FLAG_TRANSFER_BINARY Transfers the file as binary.
    '
    '   The following flags determine how the caching of this file will
    '   be done. Any combination of the following flags can be used
        'with the transfer type flag.
    '   Value                       Meaning
    '   INTERNET_FLAG_HYPERLINK     Forces a reload if there was no
    '       Expires time and no LastModified time returned from the
    '       server when determining whether to reload the item from the
    '       network.
    '   INTERNET_FLAG_NEED_FILE     Causes a temporary file to be
    '       created if the file cannot be cached.
    '   INTERNET_FLAG_RELOAD Forces a download of the requested file,
    '       object, or directory listing from the origin server, not
    '       from the cache.
    '   INTERNET_FLAG_RESYNCHRONIZE Reloads HTTP resources if the
    '       resource has been modified since the last time it was
    '       downloaded. All FTP and Gopher resources are reloaded.
    '
    '   NOTE: We'll default to FTP_TRANSFER_TYPE_BINARY for Binary
    '   transfer.
    'lngContext: Long variable that contains the application-defined
    '   value that associates this search with any application data.
    '   This is used only if the application has already called
    '   InternetSetStatusCallback to set up a status callback function.
    '
    '   NOTE: Used to identify the application context when using
    '   callbacks. Since we’re not using callbacks, we’ll pass
    '   MC_INTERNET_FLAG_NONE.

Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer
    'This function has only one parameter, hInet, that is the value of
    '   the handle to close or discard.
    
Private Declare Function FtpPutFile Lib "wininet.dll" Alias _
    "FtpPutFileA" ( _
    ByVal hConnect As Long, _
    ByVal lpszLocalFile As String, _
    ByVal strRemoteFile As String, _
    ByVal lngFlags As Long, _
    ByVal dwContext As Long) As Boolean
    'hConnect: Handle to an FTP session. It is the value of the handle
    '   returned by the InternetConnect call.
    'strNewFile: string that contains the name of the file to be sent
    '   from the local system.
    'strRemoteFile: string that contains the name of the file to be
    '   created on the remote system.
    'lngFlags: Conditions under which the transfers occur. The
    '   application should select one transfer type and any of the
    '   flags that control how the caching of the file will be
    '   controlled.
    '
    '   The transfer type can be any one of the following values.
    '   Value                       Meaning
    '   FTP_TRANSFER_TYPE_ASCII     Transfers the file using FTP's
    '       ASCII (Type A) transfer method. Control and formatting
    '       information is converted to local equivalents.
    '   FTP_TRANSFER_TYPE_BINARY    Transfers the file using FTP's
    '       Image (Type I) transfer method. The file is transferred
    '       exactly as it exists with no changes. This is the default
    '       transfer method.
    '   FTP_TRANSFER_TYPE_UNKNOWN   Defaults to
    '       FTP_TRANSFER_TYPE_BINARY.
    '   INTERNET_FLAG_TRANSFER_ASCII  Transfers the file as ASCII.
    '   INTERNET_FLAG_TRANSFER_BINARY Transfers the file as binary.
    '
    '   The following values are used to control the caching of the
    '   file. The application can use one or more of the following
    '   values.
    '   Value                       Meaning
    '   INTERNET_FLAG_HYPERLINK     Forces a reload if there was no
    '       Expires time and no LastModified time returned from the
    '       server when determining whether to reload the item from
    '       the network.
    '   INTERNET_FLAG_NEED_FILE     Causes a temporary file to be
    '       created if the file cannot be cached.
    '   INTERNET_FLAG_RELOAD        Forces a download of the requested
    '       file, object, or directory listing from the origin server,
    '       not from the cache.
    '   INTERNET_FLAG_RESYNCHRONIZE Reloads HTTP resources if the
    '       resource has been modified since the last time it was
    '       downloaded. All FTP and Gopher resources are reloaded.
    '
    '   NOTE: We’ll pass FTP_TRANSFER_TYPE_BINARY.
    'lngContext: Long variable that contains the application-defined
    '   value that associates this search with any application data.
    '   This parameter is used only if the application has already
    '   called InternetSetStatusCallback to set up a status callback.
    '
    '   NOTE: Since we’re not using callbacks, we’ll pass
    '   MC_INTERNET_FLAG_NONE.

Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias _
    "FtpDeleteFileA" ( _
    ByVal hConnect As Long, _
    ByVal lpszFileName As String) As Boolean
    'hConnect: Handle returned by a previous call to InternetConnect
    '   using INTERNET_SERVICE_FTP.
    'lpszFileName: string that contains the name of the file to be
    '   deleted on the FTP server.

Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias _
    "FtpFindFirstFileA" ( _
    ByVal hConnect As Long, _
    ByVal strSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal lngFlags As Long, _
    ByVal dwContent As Long) As Long
    'hConnect: Handle to an FTP session returned from InternetConnect
    'strSearchFile: string that specifies a valid directory path or
    '   file name for the FTP server's file system. The string can
    '   contain wildcards, but no blank spaces are allowed. If the
    '   value of strSearchFile is NULL or if it is an empty string,
    '   the function finds the first file in the current directory
    '   on the server.
    'lpFindFileData: a WIN32_FIND_DATA structure that receives
    '   information about the found file or directory The
    '   WIN32_FIND_DATA datatype is a user-defined type that holds the
    '   received information about the files in the directory. Notice
    '   that several of the variables have another user-defined
    '   datatype, FILETIME. We’ll only use the contents of
    '   dwFileAttributes, which holds the file attributes, and
    '   cFileName, which holds the file name.
    'lngFlags: Controls the behavior of this function. This parameter
    '   can be a combination of the following values.
    '       INTERNET_FLAG_HYPERLINK
    '       INTERNET_FLAG_NEED_FILE
    '       INTERNET_FLAG_NO_CACHE_WRITE
    '       INTERNET_FLAG_RELOAD
    '       INTERNET_FLAG_RESYNCHRONIZE
    '
    '   NOTE: we’ll pass MC_INTERNET_FLAG_NONE
    'dsContext: variable that specifies the application-defined value
    '   that associates this search with any application data. This
    '   parameter is used only if the application has already called
    '   InternetSetStatusCallback to set up a status callback function.
    '
    '   NOTE: we’ll pass INTERNET_NO_CALLBACK

Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias _
    "InternetFindNextFileA" ( _
    ByVal hFind As Long, _
    lpvFindData As WIN32_FIND_DATA) As Long
    'hFind: Handle returned from either FtpFindFirstFile,
    '   GopherFindFirstFile, or InternetOpenUrl (directories only).
    'lpvFindData: buffer that receives information about the file or
    '   directory. The format of the information placed in the buffer
    '   depends on the protocol in use. The FTP protocol returns a
    '   WIN32_FIND_DATA structure, and the Gopher protocol returns a
    '   GOPHER_FIND_DATA structure.
    '
    '   NOTE: We use the same user-defined type that was used in the
    '   FtpFindFirstFile call, WIN32_FIND_DATA

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
'The FILETIME structure is a 64-bit value representing the number of
'100-nanosecond intervals since January 1, 1601 (UTC).
'dwLowDateTime: Low-order part of the file time.
'dwHighDateTime: High-order part of the file time.

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * INTERNET_MAX_PATH_LENGTH
    cAlternate As String * 14
End Type
'dwFileAttributes:
    'File attributes of the file found. This member can be one or more
    'of the following values.
    'Attribute                      Meaning
    'FILE_ATTRIBUTE_ARCHIVE         The file or directory is an archive
    '   file or directory. Applications use this attribute to mark files
    '   for backup or removal.
    'FILE_ATTRIBUTE_COMPRESSED      The file or directory is
    '   compressed. For a file, this means that all of the data in the
    '   file is compressed. For a directory, this means that
    '   compression is the default for newly created files and
    '   subdirectories.
    'FILE_ATTRIBUTE_DIRECTORY       The handle identifies a directory.
    'FILE_ATTRIBUTE_ENCRYPTED       The file or directory is encrypted.
    '   For a file, this means that all data in the file is encrypted.
    '   For a directory, this means that encryption is the default for
    '   newly created files and subdirectories.
    'FILE_ATTRIBUTE_HIDDEN          The file or directory is hidden.
    '   It is not included in an ordinary directory listing.
    'FILE_ATTRIBUTE_NORMAL          The file or directory has no other
    '   attributes set. This attribute is valid only if used alone.
    'FILE_ATTRIBUTE_OFFLINE         The file data is not immediately
    '   available. This attribute indicates that the file data has been
    '   physically moved to offline storage. This attribute is used by
    '   Remote Storage, the hierarchical storage management software.
    '   Applications should not arbitrarily change this attribute.
    'FILE_ATTRIBUTE_READONLY        The file or directory is read-only.
    '   Applications can read the file but cannot write to it or delete
    '   it. In the case of a directory, applications cannot delete it.
    'FILE_ATTRIBUTE_REPARSE_POINT   The file has an associated reparse
    '   point.
    'FILE_ATTRIBUTE_SPARSE_FILE     The file is a sparse file.
    'FILE_ATTRIBUTE_SYSTEM          The file or directory is part of
    '   the operating system or is used exclusively by the operating
    '   system.
    'FILE_ATTRIBUTE_TEMPORARY       The file is being used for
    '   temporary storage. File systems attempt to keep all of the data
    '   in memory for quicker access, rather than flushing it back to
    '   mass storage. A temporary file should be deleted by the
    '   application as soon as it is no longer needed.
'ftCreationTime
    'A FILETIME structure that specifies when the file or directory was
    'created. If the underlying file system does not support creation
    'time, this member is zero.
'ftLastAccessTime
    'A FILETIME structure. For a file, the structure specifies when the
    'file was last read from or written to. For a directory, the
    'structure specifies when the directory was created. For both files
    'and directories, the specified date will be correct, but the time
    'of day will always be set to midnight. If the underlying file
    'system does not support last access time, this member is zero.
'ftLastWriteTime
    'A FILETIME structure. For a file, the structure specifies when the
    'file was last written to. For a directory, the structure specifies
    'when the directory was created. If the underlying file system does
    'not support last write time, this member is zero.
'nFileSizeHigh
    'High-order DWORD value of the file size, in bytes. This value is
    'zero unless the file size is greater than MAXDWORD. The size of
    'the file is equal to (nFileSizeHigh * (MAXDWORD+1))
    '+ nFileSizeLow.
'nFileSizeLow
    'Low-order DWORD value of the file size, in bytes.
'dwReserved0
    'If the dwFileAttributes member includes the
    'FILE_ATTRIBUTE_REPARSE_POINT attribute, this member specifies the
    'reparse tag. Otherwise, this value is undefined and should not be
    'used.
'dwReserved1
    'Reserved for future use.
'cFileName
    'A null-terminated string that specifies the name of the file.
'cAlternateFileName
    'A null-terminated string that specifies an alternative name for
    'the file. This name is in the classic 8.3 (filename.ext) file name
    'format.
'
'Remarks
    'If a file has a long file name, the complete name appears in the
    'cFileName member, and the 8.3 format truncated version of the name
    'appears in the cAlternateFileName member. Otherwise,
    'cAlternateFileName is empty. As an alternative, you can use the
    'GetShortPathName function to find the 8.3 format version of a file
    'name.
    '
    'Not all file systems can record creation and last access time and
    'not all file systems record them in the same manner. For example,
    'on NT FAT, create time has a resolution of 10 milliseconds, write
    'time has a resolution of 2 seconds, and access time has a
    'resolution of 1 day (really, the access date). On NTFS, access
    'time has a resolution of 1 hour. For more information, see File
    'Times.

Private Declare Function InternetAutodialHangup Lib "wininet.dll" ( _
    ByVal dwReserved As Long) As Boolean
'dwReserved: must be 0 (zero)


Public Function OpenInternet() As Boolean
    
    m_hInernetSession = InternetOpen(m_strAgent, m_lngAccessType, _
        m_strProxyName, m_strProxyBypass, m_lngInternetOpenFlags)
    'If the function call fails, lngINet will be 0. Otherwise,
    'lngINet holds the value of the handle that we’ll need to pass to
    'the InternetConnect function in the next step.
    If m_hInernetSession = 0 Then
        OpenInternet = False
        Exit Function
    End If
    
    m_hInternetConnection = InternetConnect(m_hInernetSession, _
        m_strServerName, m_intServerPort, _
        m_strLoginName, m_strPassword, m_lngInternetService, _
        m_lngInternetConnectFlag, m_lngInternetCallbackFlag)
    'If the function call fails, m_hInternetConnection will be 0.
    'Otherwise, m_hInternetConnection holds the value of the
    'handle that we’ll need to pass to the FtpGetFile function
    'in the next step
    If m_hInternetConnection = 0 Then
        OpenInternet = False
    Else
        OpenInternet = True
    End If
    
End Function

Public Function ReadDir( _
    Optional strSearchFile As String = "*.*") As Boolean
    On Error Resume Next ' we'll handle the errors in-line
    
    Dim pData As WIN32_FIND_DATA
    Dim lngHINet As Long
    Dim intError As Integer
    Dim strTemp As String
    Dim blnRC As Boolean

    'init the filename buffer
    pData.cFileName = String(260, 0)

    'get the first file in the directory...
    lngHINet = FtpFindFirstFile(m_hInternetConnection, _
        strSearchFile, pData, _
        m_lngFtpFindFirsFileFlag, m_lngInternetCallbackFlag)
    'If the function fails, 0 is returned. Otherwise, lngHInet is a
    'valid handle that we’ll use to continue with the directory
    'enumeration. In addition, the first file’s name and attributes are
    'stored in the pData variable.
    '
    'Once the FtpFindFirstFile function is called and returns a valid
    'handle, we’ll make calls to the InternetFindNextFile function
    'until it returns an error of 18 indicating no more files to list.

    'how'd we do?
    If lngHINet = 0 Then
        'get the error from the findfirst call
        intError = Err.LastDllError
        
        'To indicate that no more files exist, 18 is returned in the
        '   LastDllError of the Err object
        'is the directory empty?
        If intError <> MC_ERROR_NO_MORE_FILES Then
            'whoa...a real error
            'TODO: …error handler…
            ReadDir = False
            Err.Raise intError
            Exit Function
        End If
        
    Else
        
        'we got some dir info...
        'get the name
        strTemp = Left(pData.cFileName, InStr(1, pData.cFileName, _
            String(1, 0), vbBinaryCompare) - 1)

        'TODO: store the file info someplace…
                
        'now loop through the rest of the files...
        Do
            'init the filename buffer
            pData.cFileName = String(260, 0)
            
            'get the next item
            blnRC = InternetFindNextFile(lngHINet, pData)
            
            'how'd we do?
            If Not blnRC Then
            
                'get the error from the findnext call
                intError = Err.LastDllError
                
                'no more items
                If intError <> MC_ERROR_NO_MORE_FILES Then
                    'whoa...a real error
                    'TODO: …error handler…
                    ReadDir = False
                    Err.Raise intError
                    Exit Function
                    
                    'Exit Do
                
                Else
                    
                    'no more items...
                    Exit Do
                    
                End If
                
            Else
                
                'get the last item returned
                strTemp = Left(pData.cFileName, InStr(1, _
                    pData.cFileName, String(1, 0), _
                    vbBinaryCompare) - 1)
                
                'TODO: store the file info someplace…
    
            End If
            
        Loop
        
        'close the handle for the dir listing
        InternetCloseHandle lngHINet
        ReadDir = True
    End If

End Function

Public Function GetFile( _
    strFtpFile As String, _
    strLocalFile As String, _
    Optional lngFtpTransferType As Long _
        = INTERNET_FLAG_TRANSFER_BINARY) As Boolean
    
    Dim blnRC As Boolean
    
    'Get a file from the FTP server to a local folder
    blnRC = FtpGetFile(m_hInternetConnection, strFtpFile, _
        strLocalFile, m_fFailExists, m_lngFlagsAndAttributes, _
        lngFtpTransferType, m_lngInternetCallbackFlag)
    'If the function call is successful, blnRC will be True,
    ' otherwise, blnRC will be False
    
    GetFile = blnRC

End Function

Public Function PutFile(strLocalFile As String, _
    strFtpFile As String, _
    Optional lngInetTransferType As Long = INTERNET_FLAG_TRANSFER_BINARY)
    
    Dim blnRC As Boolean
    
    'Send a file from a local folder to the FTP server
    blnRC = FtpPutFile(m_hInternetConnection, strLocalFile, _
        strFtpFile, lngInetTransferType, m_lngInternetCallbackFlag)
    'If the function call is successful, blnRC will be True,
    ' otherwise, blnRC will be False
    
    PutFile = blnRC

End Function

Public Function DeleteFtpFile(strFtpFile As String)
    Dim blnRC As Boolean
    
    'Delete a file on the FTP server
    blnRC = FtpDeleteFile(m_hInternetConnection, strFtpFile)
    'If the function call is successful, blnRC will be True,
    '   otherwise, blnRC will be False
    
    DeleteFtpFile = blnRC

End Function

Public Function CloseInternet() As Boolean

    'Since, we have handles from the InternetConnection and
    'InternetOpen functions, we’ll need to call this close function
    'twice. In addition, because the InternetConnection handle is
    'dependent on the InternetOpen handle, we’ll need to close these
    'in the reverse order that we created them.
    CloseInternet = InternetCloseHandle(m_hInternetConnection)
    If Not CloseInternet Then
        Err.Raise gcErrUnknown, MODULE_NAME, gcErrUnknownDesc & _
            vbCrLf & &quot;Did not close m_hInternetConnection.&quot;
    End If
    CloseInternet = InternetCloseHandle(m_hInernetSession)
    If Not CloseInternet Then
        Err.Raise gcErrUnknown, MODULE_NAME, gcErrUnknownDesc & _
            vbCrLf & &quot;Did not close m_hInernetSession.&quot;
    End If

End Function


Private Sub Class_Initialize()
    
    'set defaults
    m_strAgent = MC_FTPAGENT    ' You can make this any descriptive
    '   name you wish to identify you to the FTP server.
    m_lngAccessType = INTERNET_OPEN_TYPE_PRECONFIG
    m_strProxyName = MC_INTERNET_PROXY_NAME_DEFAULT
    m_strProxyBypass = MC_INTERNET_PROXY_BYPASS_DEFAULT
    m_lngInternetOpenFlags = MC_INTERNET_FLAG_NONE
    m_lngInternetConnectFlag = MC_INTERNET_FLAG_NONE
    m_lngFtpFindFirsFileFlag = MC_INTERNET_FLAG_NONE
    m_intServerPort = INTERNET_INVALID_PORT_NUMBER
    m_lngInternetService = INTERNET_SERVICE_FTP
    m_lngInternetCallbackFlag = INTERNET_NO_CALLBACK
    m_fFailExists = False   'overwrite local file if it exists
    
    m_strPassword = MC_FTPPWD
    m_strServerName = MC_FTPSERVER
    m_strLoginName = MC_FTPLOGIN
    
End Sub

Public Property Get FtpAgent() As Variant
    FtpAgent = m_strAgent
End Property

Public Property Let FtpAgent(ByVal vNewValue As Variant)
    m_strAgent = CStr(vNewValue)
End Property

Public Property Get FtpPwd() As Variant
    FtpPwd = m_strPassword
End Property

Public Property Let FtpPwd(ByVal vNewValue As Variant)
    m_strPassword = CStr(vNewValue)
End Property

Public Property Get FtpServerName() As Variant
    FtpServerName = m_strServerName
End Property

Public Property Let FtpServerName(ByVal vNewValue As Variant)
    m_strServerName = CStr(vNewValue)
End Property

Public Property Get FtpLoginName() As Variant
    FtpLoginName = m_strLoginName
End Property

Public Property Let FtpLoginName(ByVal vNewValue As Variant)
    m_strLoginName = CStr(vNewValue)
End Property

Public Property Get FtpAccessType() As Variant
    FtpAccessType = m_lngAccessType
End Property

Public Property Let FtpAccessType(ByVal vNewValue As Variant)
    m_lngAccessType = CLng(vNewValue)
End Property

Public Property Get FtpProxyName() As Variant
    FtpProxyName = m_strProxyName
End Property

Public Property Let FtpProxyName(ByVal vNewValue As Variant)
    m_strProxyName = CStr(vNewValue)
End Property

Public Property Get FtpProxyBypass() As Variant
    FtpProxyBypass = m_strProxyBypass
End Property

Public Property Let FtpProxyBypass(ByVal vNewValue As Variant)
    m_strProxyBypass = CStr(vNewValue)
End Property

Public Property Get FtpFailGetIfFileExists() As Variant
    FtpFailGetIfFileExists = m_fFailExists
End Property

Public Property Let FtpFailGetIfFileExists(ByVal vNewValue As Variant)
    m_fFailExists = CBool(vNewValue)
End Property

Public Property Get FtpFileFlagsAndAttributes() As Variant
    FtpFileFlagsAndAttributes = m_lngFlagsAndAttributes
End Property

Public Property Let FtpFileFlagsAndAttributes(ByVal vNewValue As Variant)
    m_lngFlagsAndAttributes = CLng(vNewValue)
End Property

Public Function Hangup()
    Hangup = InternetAutodialHangup(0)
End Function

 

[Aswin01]

Hi,

I'm just a beginner in VB6.
I have already written a code to get some files from an FTP server... and it works well.

But I just want to add a progress bar. I have some examples but they are to complex for me... (and the example is VB.NET. But I had seen the same code on a VB6 forum but i can't find it anymore...

http://vbnet.mvps.org/index.html?code/internet/ftpdownloadcallback.htm

I just want to add a progress bar to my little program. Thats all.
my prgm code in VB6:
form with 1 button (cmdtest)

Option Explicit
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

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

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

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer



Private Sub cmdtest_Click()


'/////////////////// Veriabelen definieren ///////////////////'
Dim server As String, paswoord As String, username As String
server = "192.168.1.2"
username = "sukke"
paswoord = "jupiler666"


'/////////////////// Internet sessie starten ///////////////////'
Dim congelukt As Long
congelukt = InternetOpen(server, 1, vbNullString, vbNullString, 0)
If congelukt = 0 Then
MsgBox "connectie failed"
Exit Sub
End If


'/////////////////// Inloggen ///////////////////'
Dim coninlog As Long
coninlog = InternetConnect(congelukt, server, 0, _
username, paswoord, 1, 0, 0)
If coninlog = 0 Then
MsgBox "Inloggen Misslukt"
Exit Sub
End If


'/////////////////// File afhalen ///////////////////'
Dim condownload As Boolean
condownload = FtpGetFile(coninlog, "testfile.doc", "testfile.doc", 0, 0, 2, 0)

If condownload = False Then
MsgBox "Downloaden misslukt"
'Exit Sub
End If


'/////////////////// Inloggen ///////////////////'
InternetCloseHandle coninlog
InternetCloseHandle congelukt

End Sub


//////////////////////////////////////////////////

Could someone help me please? thx


mail: aswin.coolsaet@skynet.be

 

[Aswin01]

http://vbnet.mvps.org/index.html?code/internet/ftpdownloadcallback.htm

mail: aswin.coolsaet@skynet.be