'persistent handle to the internet
Public hInternet As Long

'persistent handle internet connection
Public hConnect As Long

'persistent handle internet callback: used to
'determine if necessary to remove before closing
Public hCallback As Long

'string to hold error set in GetECode
'on connection, deletion or upload failure
Public FtpErrorMessage As String

'flag used to show/suppress the listing of
'the FTP callback messages in List2
Public bFtpShowMessages As Boolean

'default FTP login data
Public Const sFtpUserName As String = "anonymous"
Public Const sFtpPassword As String = "youremail@whatever.com"

'default local folder for downloads
Public Const sLocalDownloadPath As String = "d:\ftptest\"

'constants are more efficient than literals
'when used in several places
Public Const sRootDots As String = ".."
Public Const sSlash As String = "/"

'variables for callback
Public dwCurrentFileSize As Double  'file size of download
Public pub_BytesSent As Double      'tracks bytes send
Public pub_BytesRecieved As Double  'tracks bytes received

'misc constants required
Private Const MAX_PATH As Long = 260
Private Const MAXDWORD As Double = (2 ^ 32) - 1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const WM_SETREDRAW As Long = &HB
Private Const GENERIC_READ As Long = &H80000000
Private Const INTERNET_SUCCESS As Long = 1

'use registry configuration
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
'direct to net
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
'via named proxy
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3
'prevent using java/script/INS
Public Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY As Long = 4
'used for FTP connections
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000

'Additional cache flags
'don't write this item to the cache
Public Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000
Public Const INTERNET_FLAG_DONT_CACHE As Long = INTERNET_FLAG_NO_CACHE_WRITE
'make this item persistent in cache
Public Const INTERNET_FLAG_MAKE_PERSISTENT As Long = &H2000000
Public Const INTERNET_FLAG_FROM_CACHE As Long = &H1000000
'use offline semantics
Public Const INTERNET_FLAG_OFFLINE As Long = INTERNET_FLAG_FROM_CACHE

'Additional flags
'use PCT/SSL if applicable (HTTP)
Public Const INTERNET_FLAG_SECURE As Long = &H800000
'use keep-alive semantics
Public Const INTERNET_FLAG_KEEP_CONNECTION As Long = &H400000
'don't handle redirections automatically
Public Const INTERNET_FLAG_NO_AUTO_REDIRECT As Long = &H200000
'do background read prefetch
Public Const INTERNET_FLAG_READ_PREFETCH As Long = &H100000
'no automatic cookie handling
Public Const INTERNET_FLAG_NO_COOKIES As Long = &H80000
'no automatic authentication handling
Public Const INTERNET_FLAG_NO_AUTH As Long = &H40000
'return cache file if net request fails
Public Const INTERNET_FLAG_CACHE_IF_NET_FAIL As Long = &H10000
'default for FTP servers
Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21
'   "     "  gopher "
Public Const INTERNET_DEFAULT_GOPHER_PORT As Long = 70
'   "     "  HTTP   "
Public Const INTERNET_DEFAULT_HTTP_PORT As Long = 80
'   "     "  HTTPS  "
Public Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443
'default for SOCKS firewall servers.
Public Const INTERNET_DEFAULT_SOCKS_PORT As Long = 1080

'FTP: use existing InternetConnect handle for server if possible
Public Const INTERNET_FLAG_EXISTING_CONNECT As Long = &H20000000
Public Const INTERNET_SERVICE_FTP As Long = 1
Public Const INTERNET_SERVICE_GOPHER As Long = 2
Public Const INTERNET_SERVICE_HTTP As Long = 3

'connected state (mutually exclusive with disconnected)
Public Const INTERNET_STATE_CONNECTED As Long = &H1
'disconnected from network
Public Const INTERNET_STATE_DISCONNECTED As Long = &H2
'disconnected by user request
Public Const INTERNET_STATE_DISCONNECTED_BY_USER As Long = &H10
'no network requests being made (by Wininet)
Public Const INTERNET_STATE_IDLE As Long = &H100
'network requests being made (by Wininet)
Public Const INTERNET_STATE_BUSY As Long = &H200

'transfer flags
Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = &H0
Private Const FTP_TRANSFER_TYPE_ASCII As Long = &H1
Private Const FTP_TRANSFER_TYPE_BINARY As Long = &H2
Private Const INTERNET_FLAG_TRANSFER_ASCII As Long = FTP_TRANSFER_TYPE_ASCII
Private Const INTERNET_FLAG_TRANSFER_BINARY As Long = FTP_TRANSFER_TYPE_BINARY
Private Const FTP_TRANSFER_TYPE_MASK As Long = (FTP_TRANSFER_TYPE_ASCII Or _
                                                FTP_TRANSFER_TYPE_BINARY)

'imternet callback messages
Public Const INTERNET_INVALID_STATUS_CALLBACK As Long = -1
Private Const INTERNET_STATUS_RESOLVING_NAME As Long = 10
Private Const INTERNET_STATUS_NAME_RESOLVED As Long = 11
Private Const INTERNET_STATUS_CONNECTING_TO_SERVER As Long = 20
Private Const INTERNET_STATUS_CONNECTED_TO_SERVER As Long = 21
Private Const INTERNET_STATUS_SENDING_REQUEST As Long = 30
Private Const INTERNET_STATUS_REQUEST_SENT As Long = 31
Private Const INTERNET_STATUS_RECEIVING_RESPONSE As Long = 40
Private Const INTERNET_STATUS_RESPONSE_RECEIVED As Long = 41
Private Const INTERNET_STATUS_CTL_RESPONSE_RECEIVED As Long = 42
Private Const INTERNET_STATUS_PREFETCH As Long = 43
Private Const INTERNET_STATUS_CLOSING_CONNECTION As Long = 50
Private Const INTERNET_STATUS_CONNECTION_CLOSED As Long = 51
Private Const INTERNET_STATUS_HANDLE_CREATED As Long = 60
Private Const INTERNET_STATUS_HANDLE_CLOSING As Long = 70
Private Const INTERNET_STATUS_DETECTING_PROXY As Long = 80
Private Const INTERNET_STATUS_REQUEST_COMPLETE As Long = 100
Private Const INTERNET_STATUS_REDIRECT As Long = 110
Private Const INTERNET_STATUS_INTERMEDIATE_RESPONSE As Long = 120
Private Const INTERNET_STATUS_USER_INPUT_REQUIRED As Long = 140
Private Const INTERNET_STATUS_STATE_CHANGE As Long = 200

'internet error flags
Private Const INTERNET_ERROR_BASE As Long = 12000
Private Const ERROR_INTERNET_OUT_OF_HANDLES As Long = (INTERNET_ERROR_BASE + 1)
Private Const ERROR_INTERNET_TIMEOUT As Long = (INTERNET_ERROR_BASE + 2)
Private Const ERROR_INTERNET_EXTENDED_ERROR As Long = (INTERNET_ERROR_BASE + 3)
Private Const ERROR_INTERNET_INTERNAL_ERROR As Long = (INTERNET_ERROR_BASE + 4)
Private Const ERROR_INTERNET_INVALID_URL As Long = (INTERNET_ERROR_BASE + 5)
Private Const ERROR_INTERNET_UNRECOGNIZED_SCHEME As Long = (INTERNET_ERROR_BASE + 6)
Private Const ERROR_INTERNET_NAME_NOT_RESOLVED As Long = (INTERNET_ERROR_BASE + 7)
Private Const ERROR_INTERNET_PROTOCOL_NOT_FOUND As Long = (INTERNET_ERROR_BASE + 8)
Private Const ERROR_INTERNET_INVALID_OPTION As Long = (INTERNET_ERROR_BASE + 9)
Private Const ERROR_INTERNET_BAD_OPTION_LENGTH As Long = (INTERNET_ERROR_BASE + 10)
Private Const ERROR_INTERNET_OPTION_NOT_SETTABLE As Long = (INTERNET_ERROR_BASE + 11)
Private Const ERROR_INTERNET_SHUTDOWN As Long = (INTERNET_ERROR_BASE + 12)
Private Const ERROR_INTERNET_INCORRECT_USER_NAME As Long = (INTERNET_ERROR_BASE + 13)
Private Const ERROR_INTERNET_INCORRECT_PASSWORD As Long = (INTERNET_ERROR_BASE + 14)
Private Const ERROR_INTERNET_LOGIN_FAILURE As Long = (INTERNET_ERROR_BASE + 15)
Private Const ERROR_INTERNET_INVALID_OPERATION As Long = (INTERNET_ERROR_BASE + 16)
Private Const ERROR_INTERNET_OPERATION_CANCELLED As Long = (INTERNET_ERROR_BASE + 17)
Private Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE As Long = (INTERNET_ERROR_BASE + 18)
Private Const ERROR_INTERNET_INCORRECT_HANDLE_STATE As Long = (INTERNET_ERROR_BASE + 19)
Private Const ERROR_INTERNET_NOT_PROXY_REQUEST As Long = (INTERNET_ERROR_BASE + 20)
Private Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND As Long = (INTERNET_ERROR_BASE + 21)
Private Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER As Long = (INTERNET_ERROR_BASE + 22)
Private Const ERROR_INTERNET_NO_DIRECT_ACCESS As Long = (INTERNET_ERROR_BASE + 23)
Private Const ERROR_INTERNET_NO_CONTEXT As Long = (INTERNET_ERROR_BASE + 24)
Private Const ERROR_INTERNET_NO_CALLBACK As Long = (INTERNET_ERROR_BASE + 25)
Private Const ERROR_INTERNET_REQUEST_PENDING As Long = (INTERNET_ERROR_BASE + 26)
Private Const ERROR_INTERNET_INCORRECT_FORMAT As Long = (INTERNET_ERROR_BASE + 27)
Private Const ERROR_INTERNET_ITEM_NOT_FOUND As Long = (INTERNET_ERROR_BASE + 28)
Private Const ERROR_INTERNET_CANNOT_CONNECT As Long = (INTERNET_ERROR_BASE + 29)
Private Const ERROR_INTERNET_CONNECTION_ABORTED As Long = (INTERNET_ERROR_BASE + 30)
Private Const ERROR_INTERNET_CONNECTION_RESET As Long = (INTERNET_ERROR_BASE + 31)
Private Const ERROR_INTERNET_FORCE_RETRY As Long = (INTERNET_ERROR_BASE + 32)
Private Const ERROR_INTERNET_INVALID_PROXY_REQUEST As Long = (INTERNET_ERROR_BASE + 33)
Private Const ERROR_INTERNET_NEED_UI As Long = (INTERNET_ERROR_BASE + 34)
Private Const ERROR_INTERNET_HANDLE_EXISTS As Long = (INTERNET_ERROR_BASE + 36)
Private Const ERROR_INTERNET_SEC_CERT_DATE_INVALID As Long = (INTERNET_ERROR_BASE + 37)
Private Const ERROR_INTERNET_SEC_CERT_CN_INVALID As Long = (INTERNET_ERROR_BASE + 38)
Private Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR As Long = (INTERNET_ERROR_BASE + 39)
Private Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR As Long = (INTERNET_ERROR_BASE + 40)
Private Const ERROR_INTERNET_MIXED_SECURITY As Long = (INTERNET_ERROR_BASE + 41)
Private Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE As Long = (INTERNET_ERROR_BASE + 42)
Private Const ERROR_INTERNET_POST_IS_NON_SECURE As Long = (INTERNET_ERROR_BASE + 43)
Private Const ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED As Long = (INTERNET_ERROR_BASE + 44)
Private Const ERROR_INTERNET_INVALID_CA As Long = (INTERNET_ERROR_BASE + 45)
Private Const ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP As Long = (INTERNET_ERROR_BASE + 46)
Private Const ERROR_INTERNET_ASYNC_THREAD_FAILED As Long = (INTERNET_ERROR_BASE + 47)
Private Const ERROR_INTERNET_REDIRECT_SCHEME_CHANGE As Long = (INTERNET_ERROR_BASE + 48)
Private Const ERROR_INTERNET_DIALOG_PENDING As Long = (INTERNET_ERROR_BASE + 49)
Private Const ERROR_INTERNET_RETRY_DIALOG As Long = (INTERNET_ERROR_BASE + 50)
Private Const ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR As Long = (INTERNET_ERROR_BASE + 52)
Private Const ERROR_INTERNET_INSERT_CD-ROM As Long = (INTERNET_ERROR_BASE + 53)
Private Const ERROR_INTERNET_FORTEZZA_LOGIN_NEEDED As Long = (INTERNET_ERROR_BASE + 54)
Private Const ERROR_INTERNET_SEC_CERT_ERRORS As Long = (INTERNET_ERROR_BASE + 55)
Private Const ERROR_INTERNET_SEC_CERT_NO_REV As Long = (INTERNET_ERROR_BASE + 56)
Private Const ERROR_INTERNET_SEC_CERT_REV_FAILED As Long = (INTERNET_ERROR_BASE + 57)

'FTP API errors
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS As Long = (INTERNET_ERROR_BASE + 110)
Private Const ERROR_FTP_DROPPED As Long = (INTERNET_ERROR_BASE + 111)
Private Const ERROR_FTP_NO_PASSIVE_MODE As Long = (INTERNET_ERROR_BASE + 112)

'gopher API errors
Private Const ERROR_GOPHER_PROTOCOL_ERROR As Long = (INTERNET_ERROR_BASE + 130)
Private Const ERROR_GOPHER_NOT_FILE As Long = (INTERNET_ERROR_BASE + 131)
Private Const ERROR_GOPHER_DATA_ERROR As Long = (INTERNET_ERROR_BASE + 132)
Private Const ERROR_GOPHER_END_OF_DATA As Long = (INTERNET_ERROR_BASE + 133)
Private Const ERROR_GOPHER_INVALID_LOCATOR As Long = (INTERNET_ERROR_BASE + 134)
Private Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE As Long = (INTERNET_ERROR_BASE + 135)
Private Const ERROR_GOPHER_NOT_GOPHER_PLUS As Long = (INTERNET_ERROR_BASE + 136)
Private Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND As Long = (INTERNET_ERROR_BASE + 137)
Private Const ERROR_GOPHER_UNKNOWN_LOCATOR As Long = (INTERNET_ERROR_BASE + 138)

'HTTP API errors
Private Const ERROR_HTTP_HEADER_NOT_FOUND As Long = (INTERNET_ERROR_BASE + 150)
Private Const ERROR_HTTP_DOWNLEVEL_SERVER As Long = (INTERNET_ERROR_BASE + 151)
Private Const ERROR_HTTP_INVALID_SERVER_RESPONSE As Long = (INTERNET_ERROR_BASE + 152)
Private Const ERROR_HTTP_INVALID_HEADER As Long = (INTERNET_ERROR_BASE + 153)
Private Const ERROR_HTTP_INVALID_QUERY_REQUEST As Long = (INTERNET_ERROR_BASE + 154)
Private Const ERROR_HTTP_HEADER_ALREADY_EXISTS As Long = (INTERNET_ERROR_BASE + 155)
Private Const ERROR_HTTP_REDIRECT_FAILED As Long = (INTERNET_ERROR_BASE + 156)
Private Const ERROR_HTTP_NOT_REDIRECTED As Long = (INTERNET_ERROR_BASE + 160)
Private Const ERROR_HTTP_COOKIE_NEEDS_CONFIRMATION As Long = (INTERNET_ERROR_BASE + 161)
Private Const ERROR_HTTP_COOKIE_DECLINED As Long = (INTERNET_ERROR_BASE + 162)
Private Const ERROR_HTTP_REDIRECT_NEEDS_CONFIRMATION As Long = (INTERNET_ERROR_BASE + 168)

'additional Internet API error codes
Private Const ERROR_INTERNET_SECURITY_CHANNEL_ERROR As Long = (INTERNET_ERROR_BASE + 157)
Private Const ERROR_INTERNET_UNABLE_TO_CACHE_FILE As Long = (INTERNET_ERROR_BASE + 158)
Private Const ERROR_INTERNET_TCPIP_NOT_INSTALLED As Long = (INTERNET_ERROR_BASE + 159)
Private Const ERROR_INTERNET_DISCONNECTED As Long = (INTERNET_ERROR_BASE + 163)
Private Const ERROR_INTERNET_SERVER_UNREACHABLE As Long = (INTERNET_ERROR_BASE + 164)
Private Const ERROR_INTERNET_PROXY_SERVER_UNREACHABLE As Long = (INTERNET_ERROR_BASE + 165)
Private Const ERROR_INTERNET_BAD_AUTO_PROXY_SCRIPT As Long = (INTERNET_ERROR_BASE + 166)
Private Const ERROR_INTERNET_UNABLE_TO_DOWNLOAD_SCRIPT As Long = (INTERNET_ERROR_BASE + 167)
Private Const ERROR_INTERNET_SEC_INVALID_CERT As Long = (INTERNET_ERROR_BASE + 169)
Private Const ERROR_INTERNET_SEC_CERT_REVOKED As Long = (INTERNET_ERROR_BASE + 170)

'Internet Autodial specific errors
Private Const ERROR_INTERNET_FAILED_DUETOSECURITYCHECK As Long = (INTERNET_ERROR_BASE + 171)
Private Const ERROR_INTERNET_NOT_INITIALIZED As Long = (INTERNET_ERROR_BASE + 172)
Private Const ERROR_INTERNET_NEED_MSN_SSPI_PKG As Long = (INTERNET_ERROR_BASE + 173)
Private Const ERROR_INTERNET_LOGIN_FAILURE_DISPLAY_ENTITY_BODY As Long = (INTERNET_ERROR_BASE + 174)
Private Const INTERNET_ERROR_LAST = ERROR_INTERNET_FAILED_DUETOSECURITYCHECK

'for the list tabs
Public Const LB_SETTABSTOPS As Long = &H192

'required VB Types
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public 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 * MAX_PATH
   cAlternate As String * 14
End Type

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Private Type OVERLAPPED
   Internal As Long
   InternalHigh As Long
   offset As Long
   OffsetHigh As Long
   hEvent As Long
End Type

Private Type INTERNET_ASYNC_RESULT
   dwResult As Long
   dwError As Long
End Type

'required callback enum & var
Private Enum FTP_STATES
   FTP_WAIT
   FTP_ENUM
   FTP_DOWNLOAD
   FTP_DOWNLOADING
   FTP_UPLOAD
   FTP_UPLOADING
   FTP_CREATINGDIR
   FTP_CREATEDIR
   FTP_REMOVINGDIR
   FTP_REMOVEDIR
   FTP_DELETINGFILE
   FTP_DELETEFILE
   FTP_RENAMINGFILE
   FTP_RENAMEFILE
   FTP_ENUMFILES
End Enum

Private CurrentState As FTP_STATES

Public Declare Function InternetOpen Lib "wininet" _
   Alias "InternetOpenA" _
  (ByVal lpszAgent As String, _
   ByVal dwAccessType As Long, _
   ByVal lpszProxyName As String, _
   ByVal lpszProxyBypass As String, _
   ByVal dwFlags As Long) As Long
   
Public Declare Function InternetCloseHandle Lib "wininet" _
   (ByVal hEnumHandle As Long) As Long
      
Public Declare Function InternetConnect Lib "wininet" _
   Alias "InternetConnectA" _
  (ByVal hInternet As Long, _
   ByVal lpszServerName As String, _
   ByVal nServerPort As Long, _
   ByVal lpszUserName As String, _
   ByVal lpszPassword As String, _
   ByVal dwService As Long, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long) As Long
   
Public Declare Function FtpFindFirstFile Lib "wininet" _
   Alias "FtpFindFirstFileA" _
  (ByVal hConnect As Long, _
   ByVal lpszSearchFile As String, _
   lpFindFileData As Any, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long) As Long

Private Declare Function InternetFindNextFile Lib "wininet" _
   Alias "InternetFindNextFileA" _
  (ByVal hFind As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Public Declare Function InternetSetStatusCallback Lib "wininet" _
  (ByVal hInternet As Long, _
   ByVal lpfnInternetCallback As Long) As Long
   
Private Declare Function InternetGetLastResponseInfo Lib "wininet" _
   Alias "InternetGetLastResponseInfoA" _
  (lpdwError As Long, _
   ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Long

Private Declare Function FtpGetCurrentDirectory Lib "wininet" _
   Alias "FtpGetCurrentDirectoryA" _
  (ByVal hConnect As Long, _
   ByVal lpszCurrentDirectory As String, _
    lpdwCurrentDirectory As Long) As Long

Public Declare Function FtpSetCurrentDirectory Lib "wininet" _
   Alias "FtpSetCurrentDirectoryA" _
  (ByVal hConnect As Long, _
   ByVal lpszDirectory As String) As Long

Private Declare Function FtpGetFileSize Lib "wininet" _
  (ByVal hConnect As Long, _
   lpdwFileSizeHigh As Long) As Long
 
Private Declare Function FtpOpenFile Lib "wininet" _
   Alias "FtpOpenFileA" _
  (ByVal hConnect As Long, _
   ByVal lpszFileName As String, _
   ByVal dwAccess As Long, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long) As Long

Private Declare Function FtpGetFile Lib "wininet" _
   Alias "FtpGetFileA" _
  (ByVal hConnect As Long, _
   ByVal lpszRemoteFile As String, _
   ByVal lpszNewFile As String, _
   ByVal fFailIfExists As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal dwFlags As Long, _
   ByVal dwContext As Long) As Long
   
Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
        
Private Declare Sub MoveMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, _
   pFrom As Any, _
   ByVal lSize As Long)

Public Declare Function StrFormatByteSizeW Lib "shlwapi.dll " _
  (ByVal qdwLow As Long, _
   ByVal qdwHigh As Long, _
   pwszBuf As Any, _
   ByVal cchBuf As Long) As Long
   
   
Public Function FtpFileGetFileSize(WFD As WIN32_FIND_DATA) As Double

   FtpFileGetFileSize = (WFD.nFileSizeHigh * (MAXDWORD + 1)) + WFD.nFileSizeLow
   
End Function


Public Function FtpFileGetFileSizeStr(WFD As WIN32_FIND_DATA) As String

   Dim sSize As String
   
   sSize = Space$(64)
   Call StrFormatByteSizeW(WFD.nFileSizeLow, _
                           WFD.nFileSizeHigh * (MAXDWORD + 1), _
                           ByVal StrPtr(sSize), 64)

   FtpFileGetFileSizeStr = sSize
                                       
                                       
End Function


Public Function GetInternetConnectHandle() As Long

   Dim sServerName As String

  'GetInternetConnectHandle obtains a new
  'handle expressly for use with the
  'FtpFindFirstFile and APIs.
  '
  'Care must be taken to close only the handle
  'returned by this function once the listing
  'of the directory has been obtained.
  '
  'A temporary variable is used here
  'to reduce line length
   If hInternet Then
   
     'Pass the same server as with other
     'calls, along with the requisite username
     'and password. The Microsoft FTP site
     'allows anonymous login, so the username
     'is 'anonymous' and the password is the
     'user's email address.
      sServerName = frmFtp.Combo1.Text

     'return the connection handle
      GetInternetConnectHandle = InternetConnect(hInternet, _
                                                 sServerName, _
                                                 0, _
                                                 sFtpUserName, _
                                                 sFtpPassword, _
                                                 INTERNET_SERVICE_FTP, _
                                                 INTERNET_FLAG_EXISTING_CONNECT Or _
                                                 INTERNET_FLAG_PASSIVE, _
                                                 &H0)
                            
   End If
      
End Function


Public Function GetFtpDirectory(hConnect As Long) As String

   Dim nCurrDir As Long
   Dim sCurrDir As String
   
  'FtpGetCurrentDirectory retrieves the current
  'directory for the connection. Using this API
  'means it is not necessary to track the directory
  'hierarchy for navigation.
  
  'pad the requisite buffers
   sCurrDir = Space$(MAX_PATH)
   nCurrDir = Len(sCurrDir)
      
  'FtpGetCurrentDirectory returns 1 if successful
   If FtpGetCurrentDirectory(hConnect, sCurrDir, nCurrDir) = 1 Then
      
     'return a properly qualified path
      GetFtpDirectory = QualifyUrl(StripNull(sCurrDir))
      
   End If

End Function


Public Function FtpCallbackStatus(ByVal hInternet As Long, _
                                  ByVal dwContext As Long, _
                                  ByVal dwInternetStatus As Long, _
                                  ByVal lpvStatusInfo As Long, _
                                  ByVal dwStatusInfoLength As Long) As Long
   
   Dim sMsg As String
   Dim cBuffer As String
   Dim dwRead As Long
   Dim uStatus As INTERNET_ASYNC_RESULT

   cBuffer = Space$(dwStatusInfoLength)

   Select Case dwInternetStatus
      Case INTERNET_STATUS_RESOLVING_NAME
         MoveMemory ByVal cBuffer, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Looking up the IP address for " & StripNull(cBuffer)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_NAME_RESOLVED
         MoveMemory ByVal cBuffer, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Name resolved " & StripNull(cBuffer)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_CONNECTING_TO_SERVER
         MoveMemory ByVal cBuffer, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Connecting to server..." & StripNull(cBuffer)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_CONNECTED_TO_SERVER
         sMsg = "Connected to server."
         MoveMemory ByVal cBuffer, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Connected to " & StripNull(cBuffer)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_SENDING_REQUEST
      
         MoveMemory dwRead, ByVal lpvStatusInfo, dwStatusInfoLength
         
         pub_BytesSent = pub_BytesSent + dwRead

         Select Case CurrentState
            Case FTP_UPLOADING
            
              'show the percent complete
               frmFtp.FloodUpdateTextPC dwCurrentFileSize, _
                                        pub_BytesSent
                                        
              'the IIf statement assures the
              'code will not attempt to set a
              'prog bar value greater than Max
               frmFtp.ProgressBar1.Value = IIf(pub_BytesSent < dwCurrentFileSize, _
                                               pub_BytesSent, _
                                               dwCurrentFileSize)
               
              'if selected, update the list
              'with the upload messages
               If bFtpShowMessages Then
                  sMsg = "Uploading   " & _
                         CStr(pub_BytesSent) & _
                         " of " & dwCurrentFileSize
                  Call UpdateList(sMsg)
               End If
               
            Case Else
            
               sMsg = "Sending request: " & dwRead & " bytes"
               Call UpdateList(sMsg)
            
         End Select
         
      Case INTERNET_STATUS_REQUEST_SENT
         MoveMemory dwRead, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Request sent: " & dwRead & " bytes"
         pub_BytesSent = pub_BytesSent + dwRead
      
      Case INTERNET_STATUS_RESPONSE_RECEIVED
         MoveMemory dwRead, ByVal lpvStatusInfo, dwStatusInfoLength
         pub_BytesRecieved = pub_BytesRecieved + CSng(dwRead)
         
         Select Case CurrentState
            Case FTP_DOWNLOADING

              'show the percent complete
               frmFtp.FloodUpdateTextPC dwCurrentFileSize, _
                                        pub_BytesRecieved
               
              'the IIf statement assures the
              'code will not attempt to set a
              'prog bar value greater than Max
               frmFtp.ProgressBar1.Value = IIf(pub_BytesRecieved < dwCurrentFileSize, _
                                               pub_BytesRecieved, _
                                               dwCurrentFileSize)

              'if selected, update the list
              'with the upload messages
               If bFtpShowMessages Then
                  sMsg = "Downloading   " & _
                         CStr(pub_BytesRecieved) & _
                         " of " & dwCurrentFileSize
                  Call UpdateList(sMsg)
               End If

            Case Else
               sMsg = sMsg = "Response received: " & dwRead & " bytes"
               Call UpdateList(sMsg)

         End Select
         
      Case INTERNET_STATUS_RECEIVING_RESPONSE
      Case INTERNET_STATUS_CTL_RESPONSE_RECEIVED
      Case INTERNET_STATUS_PREFETCH
      Case INTERNET_STATUS_CLOSING_CONNECTION
         sMsg = "Closing connection"
         frmFtp.FloodShowConnectAction sMsg
      
      Case INTERNET_STATUS_CONNECTION_CLOSED
         sMsg = "Connection closed"
         frmFtp.FloodShowConnectAction sMsg
         
      Case INTERNET_STATUS_HANDLE_CREATED
         MoveMemory dwRead, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "Handle created: " & CStr(dwRead)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_HANDLE_CLOSING
         sMsg = "Handle closed"
         
         If CurrentState = FTP_DOWNLOADING Then
            sMsg = "Download complete. " & sMsg
            CurrentState = FTP_WAIT
         End If
         
         If CurrentState = FTP_UPLOADING Then
            sMsg = "Upload complete. " & sMsg
            CurrentState = FTP_WAIT
         End If
         
         Call UpdateList(sMsg)
         
      Case INTERNET_STATUS_DETECTING_PROXY
         sMsg = "Detecting proxy"
         frmFtp.FloodShowConnectAction sMsg
         
      Case INTERNET_STATUS_REQUEST_COMPLETE
        sMsg = "Request completed"
        frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_REDIRECT
         MoveMemory ByVal cBuffer, ByVal lpvStatusInfo, dwStatusInfoLength
         sMsg = "HTTP request redirected to " & StripNull(cBuffer)
         frmFtp.FloodShowConnectAction sMsg

      Case INTERNET_STATUS_INTERMEDIATE_RESPONSE
         sMsg = "Received intermediate status message from the server."
         Call UpdateList(sMsg)

      Case INTERNET_STATUS_STATE_CHANGE
        'Moved between a secure and a non-secure site.
         MoveMemory dwRead, ByVal lpvStatusInfo, dwStatusInfoLength
      
         Select Case dwRead
            Case INTERNET_STATE_CONNECTED
               sMsg = "Connected state moved between secure and nonsecure site"
            
            Case INTERNET_STATE_DISCONNECTED
               sMsg = "Disconnected from network."
               frmFtp.FloodShowConnectAction sMsg
            
            Case INTERNET_STATE_DISCONNECTED_BY_USER
               sMsg = "Disconnected by user request."
               frmFtp.FloodShowConnectAction sMsg
      
            Case INTERNET_STATE_IDLE
               sMsg = "No network requests are being made (by Wininet)."
            
            Case INTERNET_STATE_BUSY
               sMsg = "Network requests are being made (by Wininet)."
                        
            Case INTERNET_STATUS_USER_INPUT_REQUIRED
               sMsg = "The request requires user input to complete."
               
         End Select
         
         Call UpdateList(sMsg)

   End Select
   
'  'upload and download messages are set
'  'above as required. This handles the other cases.
'   If CurrentState <> FTP_UPLOADING And _
'      CurrentState <> FTP_DOWNLOADING Then
'      Call UpdateList(sMsg)
'   End If

End Function


Public Function FtpFileDownload(sRemoteFile As String, _
                                sNewLocalFile As String, _
                                WFD As WIN32_FIND_DATA, _
                                bFailIfExists As Long) As Boolean

  'Show the wait cursor
   Screen.MousePointer = vbHourglass
   
  'Only if a valid connection...
   If hConnect Then
            
     'dwCurrentFileSize is used in the
     'callback and progress routine
      dwCurrentFileSize = FtpFileGetFileSize(WFD)
      
     'create the progress window passing the
     'upload file size, and a message to display
      frmFtp.FloodDisplay dwCurrentFileSize, _
                          "Downloading " & sRemoteFile & _
                          " to " & sNewLocalFile
      
     'this is the key ... set the current
     'FTP state to downloading
      CurrentState = FTP_DOWNLOADING
      
     'download the file
      If FtpGetFile(hConnect, _
                    sRemoteFile, _
                    sNewLocalFile, _
                    bFailIfExists, _
                    FILE_ATTRIBUTE_ARCHIVE, _
                    FTP_TRANSFER_TYPE_UNKNOWN, _
                    1) Then
         
        'show the success message
         FtpFileDownload = True
                       
      Else
      
        'set the error message and return
         FtpErrorMessage = GetECode(Err.LastDllError)
         FtpFileDownload = False
      
      End If  'If FtpGetFile
   End If 'If hConnect


   CurrentState = 0
   Screen.MousePointer = vbDefault
   
End Function


Public Sub GetFtpDirectoryContents()

   Dim hFind As Long
   Dim hFindConnect As Long
   Dim sPath As String
   Dim sPathOnly As String
   Dim WFD As WIN32_FIND_DATA

  'Show the wait cursor
   Screen.MousePointer = vbHourglass
   frmFtp.List1.Clear

  'Obtain the current FTP path
   sPathOnly = GetFtpDirectory(hConnect)
   
  'If the path is not the FTP base directory,
  'add ".." to provide a means of navigating
  'back up the directory structure.
   If sPathOnly <> sSlash Then
      frmFtp.List1.AddItem sRootDots
   End If
   
  'The search parameters .. here we'll list
  'all file types. Since GetFTPDirectory takes
  'care of qualifying the path, no terminating
  'slash is required.
   sPath = sPathOnly & "*.*"
      
  'Connection handles used by the FtpFindFirstFile
  'API go out of scope once the all files are
  'listed, therefore it can not be reused.
  'This restriction is handled by obtaining
  'a fresh connection handle each time a call
  'to FtpFindFirstFile is required, and releasing
  'it once finished.
   hFindConnect = GetInternetConnectHandle()
   
  'If a good connection handle ...
   If hFindConnect Then
   
     '..obtain the handle to the files with
     'the FtpFindFirstFile API. Obtaining the
     'directory contents is essentially similar
     'to using the Win32 file system APIs
     'FindFirstFile and FindNextFile, with the
     'sole exception that there is no FtpFindNextFile
     'API. Instead, successive calls are made
     'to InternetFindNextFile. The data returned
     'is in the familiar WIN32_FIND_DATA structure.
      hFind = FtpFindFirstFile(hFindConnect, _
                               sPath, WFD, _
                               INTERNET_FLAG_RELOAD Or _
                               INTERNET_FLAG_NO_CACHE_WRITE, _
                               0&)
   
        'If a valid find handle returned,
        'loop through the directory listing
        'the contents. If the attributes of
        'the returned string indicate a folder,
        'append a slash to make it both visually
        'stand out in the list, and identifiable
        'in the list double-click routine for
        'navigation.
        '
        'hFile will be 0 if the navigated-to
        'folder is empty.
         If hFind Then
         
           'suspend redraw on the file list
            Call SendMessage(frmFtp.List1.hwnd, _
                             WM_SETREDRAW, _
                             0&, ByVal 0&)
            
            Do
                  
              'if a folder
               If WFD.dwFileAttributes And vbDirectory Then
                  
                 'append a slash and add to list
                  frmFtp.List1.AddItem QualifyUrl(StripNull(WFD.cFileName))
                        
               Else

                 'add the item and its file size
                  frmFtp.List1.AddItem StripNull(WFD.cFileName) & _
                                       vbTab & _
                                       FtpFileGetFileSizeStr(WFD)
                  
               End If  'If WFD.dwFileAttributes
                  
               frmFtp.List1.Refresh
            
           'continue while valid
            Loop While InternetFindNextFile(hFind, WFD)
            
            Call SendMessage(frmFtp.List1.hwnd, _
                             WM_SETREDRAW, _
                             True, ByVal 0&)
         
         End If 'If hFind

   End If  'If hFindConnect
   
  'clean up by closing the handles used in this routine
   Call InternetCloseHandle(hFind)
   Call InternetCloseHandle(hFindConnect)

   Screen.MousePointer = vbDefault
   
End Sub


Public Function GetECode(ByVal lErrorCode As Long) As String

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' From       : MSDN
' Name       : GetECode
' Purpose    : Provides message corresponding to DLL error codes
' Parameters : The DLL error code
' Return val : String containing message
' Algorithm  : Selects the appropriate string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   Dim sBuffer As String
   Dim nBuffer As Long

   Select Case lErrorCode
      Case 12001: GetECode = "No more handles could be generated at this time"
      Case 12002: GetECode = "The request has timed out."
      Case 12003:
         'extended error. Retrieve the details using
         'the InternetGetLastResponseInfo API.
         
         sBuffer = Space$(256)
         nBuffer = Len(sBuffer)
         
         If InternetGetLastResponseInfo(lErrorCode, sBuffer, nBuffer) Then
            GetECode = StripNull(sBuffer)
         Else
            GetECode = "Extended error returned from server."
         End If
         
      Case 12004: GetECode = "An internal error has occurred."
      Case 12005: GetECode = "URL is invalid."
      Case 12006: GetECode = "URL scheme could not be recognized, " & _
                             "or is not supported."
      Case 12007: GetECode = "Server name could not be resolved."
      Case 12008: GetECode = "Requested protocol could not be located."
      Case 12009: GetECode = "A request to InternetQueryOption or " & _
                             "InternetSetOption specified an invalid option value."
      Case 12010: GetECode = "Length of an option supplied to InternetQueryOption " & _
                             "or InternetSetOption is incorrect for the type " & _
                             "of option specified."
      Case 12011: GetECode = "The request option can not be set, only queried. "
      Case 12012: GetECode = "The Win32 Internet support is being shutdown or unloaded."
      Case 12013: GetECode = "Request to connect and login to an FTP server could not" & _
                             "be completed because the supplied user name is incorrect."
      Case 12014: GetECode = "Request to connect and login to an FTP server could not " & _
                             "be completed because the supplied password is incorrect. "
      Case 12015: GetECode = "Request to connect to and login to an FTP server failed."
      Case 12016: GetECode = "Requested operation is invalid. "
      Case 12017: GetECode = "Operation was cancelled, usually because the handle on " & _
                             "which the request was operating was closed before the " & _
                             "operation completed."
      Case 12018: GetECode = "Type of handle supplied is incorrect for this operation."
      Case 12019: GetECode = "Requested operation can not be carried out because the " & _
                             "handle supplied is not in the correct state."
      Case 12020: GetECode = "Request can not be made via a proxy."
      Case 12021: GetECode = "A required registry value could not be located. "
      Case 12022: GetECode = "A required registry value was located but is an " & _
                             "incorrect type or has an invalid value."
      Case 12023: GetECode = "Direct network access cannot be made at this time. "
      Case 12024: GetECode = "An asynchronous request could not be made because " & _
                             "a zero context value was supplied."
      Case 12025: GetECode = "An asynchronous request could not be made because " & _
                             "a callback function has not been set."
      Case 12026: GetECode = "The required operation could not be completed " & _
                             "because one or more requests are pending."
      Case 12027: GetECode = "The format of the request is invalid."
      Case 12028: GetECode = "The requested item could not be located."
      Case 12029: GetECode = "The attempt to connect to the server failed."
      Case 12030: GetECode = "The connection with the server has been terminated."
      Case 12031: GetECode = "The connection with the server has been reset."
      Case 12036: GetECode = "The request failed because the handle already exists."
      Case Else: GetECode = "Error details not available."
   End Select

End Function


Public Function StripNull(item As String)

   'return a string without the chr$(0) terminator
    Dim pos As Long

    pos = InStr(item, Chr$(0))
    
    If pos Then
       StripNull = Left$(item, pos - 1)
    Else
       StripNull = item
    End If

End Function


Public Function QualifyPath(sPath As String) As String

  'assures that a passed path ends in a slash
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function


Public Function QualifyUrl(sPath As String) As String

  'assures that a passed URL ends in a slash
   If Right$(sPath, 1) <> "/" Then
      QualifyUrl = sPath & "/"
   Else
      QualifyUrl = sPath
   End If
      
End Function


Private Sub UpdateList(sMsg As String)

  'if showing messages, add the new
  'item and scroll the list to keep
  'in view.
   If bFtpShowMessages Then
      frmFtp.List2.AddItem sMsg
      frmFtp.List2.TopIndex = frmFtp.List2.NewIndex
   End If
   
End Sub

Option Explicit

Private sProgressMessage As String
Dim f As PictureBox


Private Sub Form_Load()
   
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2.6
   
   Label2.Caption = "Closed"
   Label3.Caption = "No connection"
   Text1.Text = ""
   lblStatus.Caption = ""
   Command2.Enabled = False
   Command3.Enabled = False
   Command4.Enabled = False
   tbFlood.AutoRedraw = True 'else we won't see the progress!
   
   Check2.Value = 1
   
  'tabs for the file/folder and size display
   ReDim TabArray(0 To 0) As Long
   TabArray(0) = 142
   
  'Clear existing tabs and set the tabs
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   List1.Refresh
     
   With Combo1
     .AddItem "127.0.0.1"  'localhost
     .AddItem "ftp.microsoft.com"
     .AddItem "ftp.netscape.com"
     .AddItem "ftp.sun.com"
     .AddItem "www.technolog.fr"
     .AddItem "www.winfiles.com"
     .AddItem "olivo.mentor.mec.es"
     .AddItem "main.amu.edu.pl"
     .AddItem "tucows.com"  'demonstrates error
     .ListIndex = 0
   End With
   
   Command1.Caption = "Open Connction"
   Command2.Caption = "Close Connction"
   Command3.Caption = "Download"
   Command4.Caption = "FtpFindFirstFile"
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

  'if the handles are still valid,
  'clean up before exiting
  
   If (hCallback <> INTERNET_INVALID_STATUS_CALLBACK) And _
     (hCallback <> 0) And _
      hInternet Then
   
   'remove the current callback
     Call InternetSetStatusCallback(hCallback, 0&)
   End If
     
   If hConnect Then InternetCloseHandle (hConnect)
   If hInternet Then InternetCloseHandle (hInternet)
   
End Sub


Private Sub Command1_Click()
   
   Dim sServerName As String
   
  'Show the wait cursor
   Screen.MousePointer = vbHourglass
   
  'Begin the FTP process by obtaining a
  'handle to an internet session. This
  'handle will be used in subsequent calls,
  'so its declared as a form-wide variable.
   hInternet = InternetOpen("VBnet FTP Transfer", _
                      INTERNET_OPEN_TYPE_DIRECT, _
                      vbNullString, _
                      vbNullString, _
                      INTERNET_FLAG_NO_CACHE_WRITE)
   
   
  'If a handle was obtained, the next step is
  'to obtain a connection handle that will be
  'used for all operations except the FTP
  'directory navigation. The MSDN states that
  'the handle used by FtpFindFirstFile and subsequent
  'file calls can not be reused for additional
  'navigation or other operations.
   If hInternet Then
   
   'create the callback to handle user
   'actions and reflect status codes
     hCallback = InternetSetStatusCallback(hInternet, _
                                           AddressOf FtpCallbackStatus)
     
   'if successful, hCallback will be either zero
   'if this is the first call, or the handle of
   'the previously started callback. It will
   'be -1 if invalid.
     If hCallback <> INTERNET_INVALID_STATUS_CALLBACK Then
    
       sServerName = Combo1.Text
         
      'get a connection handle
       hConnect = InternetConnect(hInternet, _
                                  sServerName, _
                                  INTERNET_DEFAULT_FTP_PORT, _
                                  sFtpUserName, _
                                  sFtpPassword, _
                                  INTERNET_SERVICE_FTP, _
                                  INTERNET_FLAG_EXISTING_CONNECT Or _
                                  INTERNET_FLAG_PASSIVE, _
                                  1&)
   
      'if the connection handle is valid, get
      'the current FTP directory
       If hConnect <> 0 Then
       
        'reflect the current path in the
        'text box (it should be '\' ) and
        'get the directory contents
         Text1.Text = GetFtpDirectory(hConnect)
         Call GetFtpDirectoryContents
         
       Else
       
        'show the error
         lblStatus.Caption = GetECode(Err.LastDllError)
         
       End If  'If hConnect
     
     End If  'If InternetSetStatusCallback
     
   End If  'If hInternet
   
  'display the session handles
   Label3.Caption = hInternet
   Label2.Caption = hConnect
   
  'If both handles are valid, disable the Open button
  'and enable the FTP button. If *either* handle is
  'valid, enable the close button. The download
  'button is false.
   Command1.Enabled = (hInternet = 0) And (hConnect = 0)
   Command2.Enabled = (hInternet <> 0) And (hConnect <> 0)
   Command3.Enabled = (hInternet <> 0) Or (hConnect <> 0)
   Command4.Enabled = False
   Combo1.Enabled = (hInternet = 0) And (hConnect = 0)
         
   Screen.MousePointer = vbDefault

End Sub


Private Sub Command2_Click()

  'clean up
   Call InternetCloseHandle(hConnect)
   Call InternetCloseHandle(hInternet)
   
   hInternet = 0
   hConnect = 0

   Label2.Caption = "Closed"
   Label3.Caption = "No connection"
   
  'If both handles are valid, enable the Open button
  'and disable the FTP button. If *either* handle is
  'valid, disable the close button. The download
  'button is disabled.
   Command1.Enabled = (hInternet = 0) And (hConnect = 0)
   Command2.Enabled = (hInternet <> 0) And (hConnect <> 0)
   Command3.Enabled = (hInternet <> 0) Or (hConnect <> 0)
   Command4.Enabled = False
   
   Combo1.Enabled = True
   lblStatus.Caption = ""
   List1.Clear
   Combo1.SetFocus
   
End Sub


Private Sub Command3_Click()
   
   Dim sFile As String
   Dim sCurrDir As String
   Dim sRemoteFile As String
   Dim sNewLocalFile As String
   Dim hFind As Long
   Dim hFindConnect As Long
   Dim WFD As WIN32_FIND_DATA
   Dim success As Boolean
   
  'this just resets the list, labels and error message
   ResetStuff
   
   If hConnect Then
     
    'get the current directory and
    'selected list item
     sCurrDir = GetFtpDirectory(hConnect)
     sFile = ParseFileFromList(List1.List(List1.ListIndex))
     
    'build the necessary strings. The
    'directory is qualified, so contains
    'the terminating slash.
     sRemoteFile = sCurrDir & sFile
     sNewLocalFile = QualifyPath(sLocalDownloadPath) & sFile
     
    'assure the file is on the server and retrieving
    'its info into a WIN32_FIND_DATA structure
     hFindConnect = GetInternetConnectHandle()
     hFind = FtpFindFirstFile(hFindConnect, _
                       sRemoteFile & vbNullString, _
                       WFD, 0&, 0&)
     lblStatus.Caption = Err.LastDllError

     'if the FtpFindFirstFile call located
     'the file then download
      If hFind <> 0 Then
    
         success = FtpFileDownload(sRemoteFile, _
                                   sNewLocalFile, _
                                   WFD, _
                                  (Check1.Value = 1)) 'if 1 then will not overwrite
          
         FloodShowTransferResult success, sNewLocalFile

      End If
     
     'clean up
      Call InternetCloseHandle(hFind)
      Call InternetCloseHandle(hFindConnect)

   End If
   
End Sub



Private Sub Command4_Click()

   Call GetFtpDirectoryContents
 
End Sub


Private Sub Check2_Click()

   bFtpShowMessages = Check2.Value = 1

End Sub


Private Sub Combo1_Click()

   Combo1 = Combo1.Text
   
End Sub


Private Sub List1_Click()

   Dim sNewPath As String
   
  'get the desired directory from the list
   sNewPath = List1.List(List1.ListIndex)
   
  'if a root item or directory is selected,
  'disable the download button
   Command4.Enabled = (Right$(sNewPath, 1) <> sSlash) And _
                 (sNewPath <> sRootDots)

End Sub


Private Sub List1_DblClick()

   Dim sNewPath As String
   Dim sPath As String
   
  'get the desired directory from the list
   sNewPath = List1.List(List1.ListIndex)
    
  'If a root item selected, exit; the routine
  'will navigate a level higher. If it is
  'a file, we don't want to navigate.
   If sNewPath <> sRootDots And Right$(sNewPath, 1) <> sSlash Then
   
     'root or file selected
      Exit Sub
     
   Else
   
     'Show the wait cursor
      Screen.MousePointer = vbHourglass
     
     'clear the list in preparation for
     'retrieving the directory contents
      List1.Clear
   
     'retrieve the current FTP path
     'using GetFTPDirectory
      sPath = GetFtpDirectory(hConnect)
     
     'qualify it if necessary, and append
     'the new path to it
      If Right$(sPath, 1) <> sSlash Then
        sPath = sPath & sSlash & sNewPath
      Else
        sPath = sPath & sNewPath
      End If
     
     'set the new path using the
     'FtpSetCurrentDirectory API
      Call FtpSetCurrentDirectory(hConnect, sPath)
     
     'reflect the new path in the text box
      Text1.Text = GetFtpDirectory(hConnect)
     
     'reload the list with the current directory
      GetFtpDirectoryContents
     
     'Show the wait cursor
      Screen.MousePointer = vbDefault
     
   End If
   
End Sub


'the Flood methods are Public as they're called from 
'the BAS module to update the download progress bar
Public Sub FloodDisplay(upperLimit, floodMessage As String)

  'set the module-level variable f
  'equal to the parent form flood panel
   Set f = tbFlood
   
  'initialize the control by setting:
  'white (the text colour)
  'black (the flood panel colour)
  'not Xor pen
  'solid fill
   f.Cls
   f.BackColor = &HFFFFFF
   f.ForeColor = &H800000
   f.DrawMode = 10
   f.FillStyle = 0
   
  'set the scalewidth equal to the
  'upper limit of the items to count
   f.ScaleWidth = upperLimit
     
   f.Cls
   f.Visible = True
   
  'set a form-level variable for the flood message
  'to avoid the need for continually passing a string
   sProgressMessage = floodMessage
   
   frmFtp.ProgressBar1.Max = upperLimit
   frmFtp.ProgressBar1.Min = 0
   frmFtp.ProgressBar1.Value = 0
   
End Sub


Public Sub FloodHide()

   f.Visible = False
   f.Cls
  
  'free the memory used by f
   Set f = Nothing
  
End Sub


Public Sub FloodUpdateTextPC(upperLimit As Double, progress As Double)

   Dim pc As String
   
   If progress <= upperLimit Then

     If progress > tbFlood.ScaleWidth Then progress = tbFlood.ScaleWidth
         
     tbFlood.Cls
     tbFlood.ScaleWidth = upperLimit
        
    'format the progress into a percentage string to display
     pc = Format$(CLng((progress / tbFlood.ScaleWidth) * 100)) + "%"
         
    'calculate the string's X & Y coordinates
    'in the PictureBox ... here, left justified and offset slightly
     tbFlood.CurrentX = 2
     tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(sProgressMessage)) \ 2
         
    'print the percentage string in the text colour
     tbFlood.Print sProgressMessage & " " & pc
        
    'print the flood bar to the new progress length in the line colour
     tbFlood.Line (0, 0)-(progress, tbFlood.ScaleHeight), tbFlood.ForeColor, BF
     
    'without this DoEvents or Refresh, the flood won't update
     tbFlood.Refresh
   
  End If

End Sub


Public Sub FloodShowTransferResult(success As Boolean, sFile As String)

   Dim sMsg As String
   
   Select Case success
     Case True:
            tbFlood.BackColor = &HFFFFFF
            tbFlood.ForeColor = &H3A633D
            sMsg = "Transfer of " & sFile & " completed successfully."
     Case False:
            tbFlood.BackColor = &HFFFFFF
            tbFlood.ForeColor = &H3D2785
            sMsg = "Transfer of " & sFile & " failed."
   End Select
   
   tbFlood.Cls
   
  'calculate the string's X & Y coordinates
  'in the Picture Box ... here, left justified and offset slightly
   tbFlood.CurrentX = 2
   tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(sMsg )) \ 2
   
  'print the percentage string in the text colour
   tbFlood.Print sMsg
   
  'print the flood bar to the new progress length in the line colour
   tbFlood.Line (0, 0)-(tbFlood.ScaleWidth, tbFlood.ScaleHeight), tbFlood.ForeColor, BF

End Sub


Public Sub FloodShowConnectAction(sConnectMsg As String)

   tbFlood.Cls
   
  'calculate the string's X & Y coordinates
  'in the PictureBox ... here, left justified and offset slightly
   tbFlood.CurrentX = 2
   tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(sConnectMsg)) \ 2
   
   tbFlood.BackColor = &HFFFFFF
   tbFlood.ForeColor = &H800000
   
  'print the percentage string in the text colour
   tbFlood.Print sConnectMsg
     
End Sub


Private Sub ResetStuff()

   List2.Clear
   
   lblStatus.Caption = ""
   
   FtpErrorMessage = ""
   
   pub_BytesSent = 0
   pub_BytesRecieved = 0

End Sub


Private Function ParseFileFromList(ByVal sSelection As String) As String

   Dim pos As Long
   
   pos = InStr(sSelection, vbTab)
   
   If pos Then
      ParseFileFromList = Left$(sSelection, pos - 1)
   Else
      ParseFileFromList = sSelection
   End If

End Function