View difference between Paste ID: sB2b7F4H and 5cFVU2Hu

 Option Explicit
 
-' //********************************************\\
+' =========================================
-' |**********************************************|
+' CFTPclient: wininet ftp functions wrapper
-' |* CFTPclient: wininet ftp functions wrapper  *|
+'             needs IE version 4 or above
-' |*             needs IE version 4 or above    *|
+' =========================================
-' |**********************************************|
+
-' \\********************************************//
+' FTP file transfer modes
 Public Enum enFtpFileMode
-' FTP transfer modes
+  ffm_Ascii = 1&
   ffm_Binary = 2&
-    ffm_Ascii = 1&
+
-    ffm_Binary = 2&
+
 ' Public events
 Public Event Connected(ByVal sServer As String, ByVal lPort As Long)
 Public Event Message(ByVal sMsg As String)
 Public Event DirLine(ByVal vAttr As VbFileAttribute, ByVal dtDateTime As Date, ByVal dSize As Double, ByVal sName As String)
 Public Event Progress(ByVal lCurrent As Long, ByVal lTotal As Long, bCancel As Boolean)
-Public Event Progress(ByVal lCurrent As Long, ByVal lTotal As Long)
+
 Public Event Disconnected(ByVal sServer As String, ByVal lPort As Long)
 
 ' ftp defaults (used in constructor)
 Private Const FTP_DEFAULT_SITE = "ftp.cisco.com"
-    sServer         As String   ' server name/ip
+Private Const FTP_DEFAULT_USER = "Anonymous"
-    nPort           As Long     ' server port
+Private Const FTP_DEFAULT_PASS = "guest@example.com"
-    sUser           As String   ' username
+Private Const FTP_DEFAULT_PASV = True
-    sPassword       As String   ' password
+
-    bPassive        As Boolean  ' true=passive mode
+
-    hInternet       As Long     ' internet session handle
+
-    hConnect        As Long     ' ftp session handle
+  sServer         As String   ' server name/ip
-    hCtx            As Long     ' context (not used)
+  nPort           As Long     ' server port
-    dwLastError     As Long     ' last error #
+  sUser           As String   ' username
-    szLastError     As String   ' last error msg
+  sPassword       As String   ' password
   bPassive        As Boolean  ' true=passive mode
   hInternet       As Long     ' internet session handle
-' Storage area
+  hConnect        As Long     ' ftp session handle
   hCtx            As Long     ' context (not used)
   dwLastError     As Long     ' last error #
   szLastError     As String   ' last error msg
 End Type
 
 ' private storage area
-    INTERNET_OPEN_TYPE_PRECONFIG = 0                     ' use system (IE) configuration
+
-    INTERNET_OPEN_TYPE_DIRECT = 1                        ' direct to net
+Private msAppName   As String             ' application name w/o ".exe"
-    INTERNET_OPEN_TYPE_PROXY = 3                         ' via named proxy
+
-    INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4   ' prevent using java/script/INS
+
 
 ' Type of internet connection
 Private Enum INTERNET_OPEN_TYPE
-Private Const INTERNET_INVALID_PORT_NUMBER = 0           ' invalid port
+  INTERNET_OPEN_TYPE_PRECONFIG = 0                        ' use system (IE) configuration
-Private Const INTERNET_DEFAULT_FTP_PORT = 21             ' default for FTP servers
+  INTERNET_OPEN_TYPE_DIRECT = 1                           ' direct to net
-Private Const INTERNET_SERVICE_FTP = 1                   ' FTP service type selector
+  INTERNET_OPEN_TYPE_PROXY = 3                            ' via named proxy
-Private Const INTERNET_FLAG_PASSIVE = &H8000000          ' passive FTP connections
+  INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4      ' preconfig, no proxy autodiscovery
-Private Const INTERNET_FLAG_RELOAD = &H80000000          ' avoid data caching
+
 
-Private Const MAX_PATH = 260                             ' max path/file size
+
-Private Const ERROR_NO_MORE_FILES = 18                   ' end of dir listing
+Private Const INTERNET_INVALID_PORT_NUMBER = 0            ' invalid port
 Private Const INTERNET_DEFAULT_FTP_PORT = 21              ' default for FTP servers
 Private Const INTERNET_SERVICE_FTP = 1                    ' FTP service type selector
 Private Const INTERNET_FLAG_PASSIVE = &H8000000           ' passive FTP connections
-    dwLowDateTime       As Long
+Private Const INTERNET_FLAG_RELOAD = &H80000000           ' avoid data caching
-    dwHighDateTime      As Long
+
 Private Const MAX_PATH = 260                              ' max path/file size
 Private Const ERROR_NO_MORE_FILES = 18                    ' end of dir listing
 
 ' FileTime (see below)
-    dwFileAttributes    As Long
+
-    ftCreationTime      As FILETIME
+  dwLowDateTime       As Long
-    ftLastAccessTime    As FILETIME
+  dwHighDateTime      As Long
-    ftLastWriteTime     As FILETIME
+
-    nFileSizeHigh       As Long
+
-    nFileSizeLow        As Long
+
-    dwReserved0         As Long
+
-    dwReserved1         As Long
+  dwFileAttributes    As Long
-    cFileName           As String * MAX_PATH
+  ftCreationTime      As FILETIME
-    cAlternate          As String * 14
+  ftLastAccessTime    As FILETIME
   ftLastWriteTime     As FILETIME
   nFileSizeHigh       As Long
   nFileSizeLow        As Long
   dwReserved0         As Long
-    wYear               As Integer
+  dwReserved1         As Long
-    wMonth              As Integer
+  cFileName           As String * MAX_PATH
-    wDayOfWeek          As Integer
+  cAlternate          As String * 14
-    wDay                As Integer
+
-    wHour               As Integer
+
-    wMinute             As Integer
+
-    wSecond             As Integer
+
-    wMilliseconds       As Integer
+  wYear               As Integer
   wMonth              As Integer
   wDayOfWeek          As Integer
   wDay                As Integer
   wHour               As Integer
-    vFileAttributes     As VbFileAttribute
+  wMinute             As Integer
-    dtCreationTime      As Date
+  wSecond             As Integer
-    dtLastAccessTime    As Date
+  wMilliseconds       As Integer
-    dtLastWriteTime     As Date
+
-    dFileSize           As Double
+
-    sFileName           As String
+
-    sAlternate          As String
+
   vFileAttributes     As VbFileAttribute
   dtCreationTime      As Date
   dtLastAccessTime    As Date
   dtLastWriteTime     As Date
   dFileSize           As Double
   sFileName           As String
   sAlternate          As String
 End Type
 
 ' Date/Time and memory manipulation
 Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFILETIME As FILETIME, lpLocalFileTime As FILETIME) As Long
 Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFILETIME As FILETIME, lpSystemTime As SYSTEMTIME) As Long
 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
 
 ' error constants
-    GENERIC_READ = &H80000000                           ' file read mode (download)
+Private Const ERROR_INTERNET_EXTENDED_ERROR = &H2EE3
-    GENERIC_WRITE = &H40000000                          ' file write mode (upload)
+
 
 ' Error messages decoding
 Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, dwArguments As Long) As Long
 Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpLibFileName As String) As Long
-    FTP_TRANSFER_TYPE_UNKNOWN = &H0&                    ' unknown (binary)
+
-    FTP_TRANSFER_TYPE_ASCII = &H1&                      ' ASCII
+
-    FTP_TRANSFER_TYPE_BINARY = &H2&                     ' binary
+
-    FTP_TRANSFER_NO_CACHE = &H80000000                  ' no caching
+  GENERIC_READ = &H80000000                           ' file read mode (download)
   GENERIC_WRITE = &H40000000                          ' file write mode (upload)
 End Enum
 
 ' FTP transfer types (private)
 Private Enum FTP_TRANSFER_TYPE
   FTP_TRANSFER_TYPE_UNKNOWN = &H0&                    ' unknown (binary)
   FTP_TRANSFER_TYPE_ASCII = &H1&                      ' ASCII
   FTP_TRANSFER_TYPE_BINARY = &H2&                     ' binary
   FTP_TRANSFER_NO_CACHE = &H80000000                  ' no caching
 End Enum
 
 
 ' open/close an internet session
 Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As INTERNET_OPEN_TYPE, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
 Private Declare Function InternetClose Lib "wininet.dll" Alias "InternetCloseHandle" (ByVal hInternet As Long) As Long
 
 ' last error code/message
 Private Declare Function InternetError Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Long
 
 ' connect/disconnect an ftp server
 Private Declare Function FtpConnect Lib "wininet.dll" 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, dwContext As Long) As Long
 Private Declare Function FtpDisconnect Lib "wininet.dll" Alias "InternetCloseHandle" (ByVal hInternet As Long) As Long
 
 ' directory operations
 Private Declare Function FtpQueryDir Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hConnect As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
 Private Declare Function FtpChangeDir Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
 Private Declare Function FtpCreateDir Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
 Private Declare Function FtpRemoveDir Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hConnect As Long, ByVal lpszDirectory As String) As Long
 Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hConnect As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, dwContext As Long) As Long
 Private Declare Function FtpFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpFindFileData As WIN32_FIND_DATA) As Long
 Private Declare Function FtpFindClose Lib "wininet.dll" Alias "InternetCloseHandle" (ByVal hInternet As Long) As Long
 
 ' file operations
 Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hConnect As Long, ByVal lpszFileName As String, ByVal dwAccess As FTP_FILE_OPEN_MODE, ByVal dwFlags As FTP_TRANSFER_TYPE, dwContext As Long) As Long
 Private Declare Function FtpFileSize Lib "wininet.dll" Alias "FtpGetFileSize" (ByVal hFile As Long, lpdwFileSizeHigh As Long) As Long
 Private Declare Function FtpBuffSize Lib "wininet.dll" Alias "InternetQueryDataAvailable" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 Private Declare Function FtpReadFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hFile As Long, ByRef lpBuffer As Byte, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
 Private Declare Function FtpWriteFile Lib "wininet.dll" Alias "InternetWriteFile" (ByVal hFile As Long, ByRef lpBuffer As Byte, ByVal dwNumberOfBytesToWrite As Long, lpdwNumberOfBytesWritten As Long) As Long
-    ' setup some reasonable defaults
+
-    With mFTP
+
-        .sServer = "ftp.cisco.com"
+
-        .nPort = INTERNET_DEFAULT_FTP_PORT
+
-        .sUser = "anonymous"
+
-        .sPassword = "guest@example.com"
+
-        .bPassive = True
+
-        .hInternet = 0
+
-        .hConnect = 0
+
-        .hCtx = 0
+  ' setup some reasonable defaults so that
-        .dwLastError = 0
+  ' just instancing the class and calling
-        .szLastError = ""
+  ' the connect method, it will work
-    End With
+  With mFTP
-    msAgent = App.EXEName & "(" & App.Major & ":" & App.Minor & ":" & App.Revision & ")"
+    .sServer = FTP_DEFAULT_SITE
-    mbDebug = False
+    .nPort = INTERNET_DEFAULT_FTP_PORT
     .sUser = FTP_DEFAULT_USER
     .sPassword = FTP_DEFAULT_PASS
     .bPassive = FTP_DEFAULT_PASV
     .hInternet = 0
     .hConnect = 0
     .hCtx = 0
     .dwLastError = 0
     .szLastError = ""
   End With
   msAppName = GetAppName()
-    mFTP.sServer = sServer
+  msAgent = msAppName & "/" & App.Major & "." & App.Minor & " (build=" & App.Revision & ")"
   mbDebug = False
 End Sub
 
-    Server = mFTP.sServer
+
 Private Sub Class_Terminate()
   On Local Error Resume Next
   Disconnect
 End Sub
-    mFTP.nPort = nPort
+
 ' .:::: Server name or IP address
 Public Property Let Server(ByVal sServer As String)
   mFTP.sServer = sServer
-    Port = mFTP.nPort
+
 
 Public Property Get Server() As String
   Server = mFTP.sServer
 End Property
-    mFTP.sUser = sUser
+
 ' .:::: server port #
 Public Property Let Port(ByVal nPort As Long)
   mFTP.nPort = nPort
-    User = mFTP.sUser
+
 
 Public Property Get Port() As Long
   Port = mFTP.nPort
 End Property
-    mFTP.sPassword = sPassword
+
 ' .:::: logon user name
 Public Property Let User(ByVal sUser As String)
   mFTP.sUser = sUser
-    Password = mFTP.sPassword
+
 
 Public Property Get User() As String
   User = mFTP.sUser
 End Property
-    mFTP.bPassive = bYesNo
+
 ' .:::: logon password
 Public Property Let Password(ByVal sPassword As String)
   mFTP.sPassword = sPassword
-    Passive = mFTP.bPassive
+
 
 Public Property Get Password() As String
   Password = mFTP.sPassword
 End Property
-    msAgent = sAgent
+
 ' .:::: passive mode
 Public Property Let Passive(ByVal bYesNo As Boolean)
   mFTP.bPassive = bYesNo
-    UserAgent = msAgent
+
 
 Public Property Get Passive() As Boolean
   Passive = mFTP.bPassive
 End Property
-    mbDebug = bYesNo
+
 ' .:::: user agent string
 Public Property Let UserAgent(ByVal sAgent As String)
   msAgent = sAgent
-    DebugMode = mbDebug
+
 
 Public Property Get UserAgent() As String
   UserAgent = msAgent
 End Property
-    Dim lErrNo As Long, lFlags As Long
+
-    Dim bRet As Boolean
+
-
+
   mbDebug = bYesNo
 End Property
-    Connect = bRet
+
-
+
-    DbgTrace "Connect " & mFTP.sServer
+  DebugMode = mbDebug
-
+
-    Err.Clear
+
-    mFTP.hInternet = InternetOpen(msAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
+' .:::: last error number/message
-    If (mFTP.hInternet = 0) Then
+Public Property Get LastErrorNum() As Long
   LastErrorNum = mFTP.dwLastError
-        Disconnect
+
-        Exit Function
+
 Public Property Get LastErrorMsg() As String
-
+  LastErrorMsg = mFTP.szLastError
-    lFlags = IIf(mFTP.bPassive, INTERNET_FLAG_PASSIVE, 0&)
+
-    Err.Clear
+
-    mFTP.hConnect = FtpConnect(mFTP.hInternet, mFTP.sServer, mFTP.nPort, mFTP.sUser, mFTP.sPassword, INTERNET_SERVICE_FTP, lFlags, mFTP.hCtx)
+
-    If (mFTP.hConnect = 0) Then
+
   Dim lErrNo As Long, lFlags As Long
-        Disconnect
+  Dim bRet As Boolean
-        Exit Function
+
   On Local Error Resume Next
   bRet = False
-    bRet = True
+  Connect = bRet
-
+
-    Connect = bRet
+  DbgTrace "Connect " & mFTP.sServer & ":" & mFTP.nPort & " " & msAgent
 
   ' acquire an internet handle
   Err.Clear
   mFTP.hInternet = InternetOpen(msAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
   If (mFTP.hInternet = 0) Then
     DecodeError
-    If mFTP.hConnect <> 0 Then
+
-        Call FtpDisconnect(mFTP.hConnect)
+
-        FtpResponse
+  End If
-        mFTP.hConnect = 0
+
   ' connect to the FTP server
-    If mFTP.hInternet <> 0 Then
+  lFlags = IIf(mFTP.bPassive, INTERNET_FLAG_PASSIVE, 0&)
-        Call InternetClose(mFTP.hInternet)
+  Err.Clear
-        mFTP.hInternet = 0
+  mFTP.hConnect = FtpConnect(mFTP.hInternet, mFTP.sServer, mFTP.nPort, mFTP.sUser, mFTP.sPassword, INTERNET_SERVICE_FTP, lFlags, mFTP.hCtx)
   If (mFTP.hConnect = 0) Then
     DecodeError
     Disconnect
     Exit Function
   End If
-    Dim sDir As String, lSize As Long, bRet As Boolean
+
-
+  RaiseEvent Connected(mFTP.sServer, mFTP.nPort)
   FtpResponse
-    lSize = 2048
+  bRet = True
-    sDir = String(lSize, vbNullChar)
+
-    bRet = FtpQueryDir(mFTP.hConnect, sDir, lSize)
+  Connect = bRet
-    If bRet = False Then
+
 
-        sDir = vbNullString
+
-    Else
+
-        FtpResponse
+  On Local Error Resume Next
   If (mFTP.hConnect <> 0) Or (mFTP.hInternet <> 0) Then
-    sDir = GetSZ(sDir)
+    RaiseEvent Disconnected(mFTP.sServer, mFTP.nPort)
-    DbgTrace "GetCurrentDirectory = " & sDir
+
-    GetCurrentDirectory = sDir
+  End If
   If mFTP.hConnect <> 0 Then
     Call FtpDisconnect(mFTP.hConnect)
     FtpResponse
     mFTP.hConnect = 0
-    Dim bRet As Boolean
+  End If
   If mFTP.hInternet <> 0 Then
     Call InternetClose(mFTP.hInternet)
-    DbgTrace "SetCurrentDirectory " & sDirectory
+    mFTP.hInternet = 0
-    bRet = FtpChangeDir(mFTP.hConnect, sDirectory)
+  End If
-    If bRet = False Then
+
 
-    Else
+
-        FtpResponse
+
   Dim sDir As String, lSize As Long, bRet As Boolean
-    SetCurrentDirectory = bRet
+
   On Local Error Resume Next
   lSize = 2048
   sDir = String(lSize, vbNullChar)
   bRet = FtpQueryDir(mFTP.hConnect, sDir, lSize)
-    Dim bRet As Boolean
+  If bRet = False Then
-
+    DecodeError
     sDir = vbNullString
-    DbgTrace "CreateDirectory " & sDirectory
+  Else
-    bRet = FtpCreateDir(mFTP.hConnect, sDirectory)
+
-    If bRet = False Then
+  End If
   sDir = GetSZ(sDir)
-    Else
+  DbgTrace "GetCurrentDirectory = " & sDir
-        FtpResponse
+  GetCurrentDirectory = sDir
 End Function
-    CreateDirectory = bRet
+
 ' .:::: set current dir path
 Public Function SetCurrentDirectory(ByVal sDirectory As String) As Boolean
   Dim bRet As Boolean
 
-    Dim bRet As Boolean
+  On Local Error Resume Next
-
+  DbgTrace "SetCurrentDirectory " & sDirectory
   bRet = FtpChangeDir(mFTP.hConnect, sDirectory)
-    DbgTrace "RemoveDirectory " & sDirectory
+  If bRet = False Then
-    bRet = FtpRemoveDir(mFTP.hConnect, sDirectory)
+    DecodeError
-    If bRet = False Then
+  Else
     FtpResponse
-    Else
+  End If
-        FtpResponse
+  SetCurrentDirectory = bRet
 End Function
-    RemoveDirectory = bRet
+
 ' .:::: create a directory
 Public Function CreateDirectory(ByVal sDirectory As String) As Boolean
   Dim bRet As Boolean
 
-    Dim hFind As Long, tFIND As WIN32_FIND_DATA
+  On Local Error Resume Next
-    Dim bFind As Boolean, lFiles As Long
+  DbgTrace "CreateDirectory " & sDirectory
-
+  bRet = FtpCreateDir(mFTP.hConnect, sDirectory)
   If bRet = False Then
-    lFiles = -1
+    DecodeError
-    ReadDirList = lFiles
+  Else
-    DbgTrace "ReadDirList " & sFileMask
+
-
+  End If
-    Err.Clear
+  CreateDirectory = bRet
-    hFind = FtpFindFirstFile(mFTP.hConnect, sFileMask, tFIND, INTERNET_FLAG_RELOAD, mFTP.hCtx)
+
-    If (hFind = 0) Then
+
 ' .:::: remove a directory (directory must be empty)
-        Exit Function
+
   Dim bRet As Boolean
 
-
+  On Local Error Resume Next
-    lFiles = 0
+  DbgTrace "RemoveDirectory " & sDirectory
   bRet = FtpRemoveDir(mFTP.hConnect, sDirectory)
-        lFiles = lFiles + 1
+  If bRet = False Then
-        DecodeDirEntry tFIND
+    DecodeError
-        bFind = FtpFindNextFile(hFind, tFIND)
+  Else
-        If bFind = False Then
+
-            If Err.LastDllError <> ERROR_NO_MORE_FILES Then
+  End If
-                DecodeError
+  RemoveDirectory = bRet
-                lFiles = -1
+
 
 ' .:::: read directory listing
-    Loop While bFind <> False
+
-
+  Dim hFind As Long, tFIND As WIN32_FIND_DATA
-    Call FtpFindClose(hFind)
+  Dim bFind As Boolean, lFiles As Long
-    If lFiles <> -1 Then
+
-        FtpResponse
+  On Local Error Resume Next
   lFiles = -1
-    ReadDirList = lFiles
+  ReadDirList = lFiles
   DbgTrace "ReadDirList " & sFileMask
 
   ' start the listing
   Err.Clear
-    Dim bRet As Boolean
+  hFind = FtpFindFirstFile(mFTP.hConnect, sFileMask, tFIND, INTERNET_FLAG_RELOAD, mFTP.hCtx)
-
+  If (hFind = 0) Then
     DecodeError
-    DbgTrace "DeleteFile " & sFileName
+
-    bRet = FtpDeleteFile(mFTP.hConnect, sFileName)
+  End If
-    If bRet = False Then
+  FtpResponse
 
-    Else
+  ' loop over FTP folder items
-        FtpResponse
+  lFiles = 0
   Do
-    DeleteFile = bRet
+    lFiles = lFiles + 1
     DecodeDirEntry tFIND
     bFind = FtpFindNextFile(hFind, tFIND)
     If bFind = False Then
       If Err.LastDllError <> ERROR_NO_MORE_FILES Then
-    Dim bRet As Boolean
+
-
+        lFiles = -1
       End If
-    DbgTrace "RenameFile " & sFileName & " -> " & sNewName
+
-    bRet = FtpRenameFile(mFTP.hConnect, sFileName, sNewName)
+  Loop While bFind <> False
-    If bRet = False Then
+
   ' cleanup and return
-    Else
+  Call FtpFindClose(hFind)
-        FtpResponse
+  If lFiles <> -1 Then
     FtpResponse
-    RenameFile = bRet
+  End If
   ReadDirList = lFiles
 End Function
 
 ' .:::: delete a file
-    Dim lMode As FTP_TRANSFER_TYPE
+
-    Dim hLocal As Long, hRemote As Long
+  Dim bRet As Boolean
-    Dim lSizeLow As Long, lSizeHigh As Long
+
-    Dim lSize As Long, lCurrent As Long
+  On Local Error Resume Next
-    Dim bRet As Boolean, bRead As Boolean
+  DbgTrace "DeleteFile " & sFileName
-    Dim cbBuff() As Byte, lBuff As Long, lBytes As Long
+  bRet = FtpDeleteFile(mFTP.hConnect, sFileName)
-
+  If bRet = False Then
     DecodeError
   Else
-    lCurrent = 0
+
-    DownloadFile = bRet
+  End If
-    DbgTrace "DownloadFile " & sRemoteFile & " -> " & sLocalFile
+  DeleteFile = bRet
-
+
-    hLocal = OpenFile(sLocalFile, True)
+
-    If hLocal = 0 Then
+
-        Exit Function
+
   Dim bRet As Boolean
-
+
-    If nMode = ffm_Ascii Then
+  On Local Error Resume Next
-        lMode = FTP_TRANSFER_TYPE_ASCII + FTP_TRANSFER_NO_CACHE
+  DbgTrace "RenameFile " & sFileName & " -> " & sNewName
-    Else
+  bRet = FtpRenameFile(mFTP.hConnect, sFileName, sNewName)
-        lMode = FTP_TRANSFER_TYPE_BINARY + FTP_TRANSFER_NO_CACHE
+  If bRet = False Then
     DecodeError
-    Err.Clear
+  Else
-    hRemote = FtpOpenFile(mFTP.hConnect, sRemoteFile, GENERIC_READ, lMode, mFTP.hCtx)
+
-    If (hRemote = 0) Then
+  End If
   RenameFile = bRet
-        Close #hLocal
+
-        Exit Function
+
 ' .:::: download (receive) a file from ftp server
 Public Function DownloadFile(ByVal sRemoteFile As String, ByVal sLocalFile As String, Optional ByVal nMode As enFtpFileMode = ffm_Binary) As Boolean
-
+  Dim lMode As FTP_TRANSFER_TYPE
-    lSizeLow = FtpFileSize(hRemote, lSizeHigh)
+  Dim hLocal As Long, hRemote As Long
-    lSize = DecodeSize(lSizeLow, lSizeHigh)
+  Dim lSizeLow As Long, lSizeHigh As Long
-    RaiseEvent Progress(lCurrent, lSize)
+  Dim lSize As Long, lCurrent As Long
-
+  Dim bRet As Boolean, bRead As Boolean
-    ' loop: read from ftp and write to file
+  Dim cbBuff() As Byte, lBuff As Long, lBytes As Long
   Dim bCancel As Boolean
 
-        bRead = FtpBuffSize(hRemote, lBuff, 0&, mFTP.hCtx)
+  On Local Error Resume Next
-        If lBuff < 1 Then
+  bRet = False
-            lBuff = 1024
+  lCurrent = 0
   DownloadFile = bRet
-        ReDim cbBuff(lBuff + 1)
+  DbgTrace "DownloadFile " & sRemoteFile & " -> " & sLocalFile
 
-        bRead = FtpReadFile(hRemote, cbBuff(0), lBuff, lBytes)
+  ' open local file for writing (delete existing)
-        If (bRead <> False) Then
+  hLocal = OpenFile(sLocalFile, True)
-            If (lBytes > 0) Then
+  If hLocal = 0 Then
-                ReDim Preserve cbBuff(lBytes - 1)
+
-                Err.Clear
+  End If
-                Put #hLocal, , cbBuff
+
-                If Err.Number <> 0 Then
+  ' open remote file for reading
-                    RaiseEvent Failure(Err.Number, Err.Description)
+  If nMode = ffm_Ascii Then
-                    DbgTrace "Error: " & Err.Number & " " & Err.Description
+    lMode = FTP_TRANSFER_TYPE_ASCII
-                    bRead = False
+  Else
-                    bRet = False
+    lMode = FTP_TRANSFER_TYPE_BINARY
-                Else
+  End If
-                    lCurrent = lCurrent + lBytes
+  lMode = lMode + FTP_TRANSFER_NO_CACHE
-                    RaiseEvent Progress(lCurrent, lSize)
+  Err.Clear
-                End If
+  hRemote = FtpOpenFile(mFTP.hConnect, sRemoteFile, GENERIC_READ, lMode, mFTP.hCtx)
-            Else
+  If (hRemote = 0) Then
-                bRead = False
+    DecodeError
-                bRet = True
+
     Exit Function
   End If
-            DecodeError
+  FtpResponse
 
   ' read the remote file size
   lSizeLow = FtpFileSize(hRemote, lSizeHigh)
   lSize = DecodeSize(lSizeLow, lSizeHigh)
-
+  RaiseEvent Progress(lCurrent, lSize, bCancel)
-    If bRet = True Then
+
-        RaiseEvent Progress(lCurrent, lSize)
+  ' loop: read from ftp and write to file
   If Not bCancel Then
-    Call FtpCloseFile(hRemote)
+
-    If bRet = True Then
+
-        FtpResponse
+      ' find out the current read buffer size
       bRead = FtpBuffSize(hRemote, lBuff, 0&, mFTP.hCtx)
       If lBuff < 1 Then
-
+        lBuff = 1024
-    DownloadFile = bRet
+      End If
       ReDim cbBuff(lBuff + 1)
       lBytes = 0
       ' read a chunk from remote file
       bRead = FtpReadFile(hRemote, cbBuff(0), lBuff, lBytes)
-    Dim lMode As FTP_TRANSFER_TYPE
+      If (bRead <> False) Then
-    Dim hLocal As Long, hRemote As Long
+        If (lBytes > 0) Then
-    Dim lSizeLow As Long, lSizeHigh As Long
+          ' write local file
-    Dim lSize As Long, lCurrent As Long, lRemainder As Long
+          ReDim Preserve cbBuff(lBytes - 1)
-    Dim bRet As Boolean, bWrite As Boolean
+          Err.Clear
-    Dim cbBuff() As Byte, lBuff As Long, lBytes As Long
+          Put #hLocal, , cbBuff
-
+          If Err.Number <> 0 Then
             RaiseEvent Failure(Err.Number, Err.Description)
             DbgTrace "Error: " & Err.Number & " " & Err.Description
-    lCurrent = 0
+
-    UploadFile = bRet
+
-    DbgTrace "UploadFile " & sLocalFile & " -> " & sRemoteFile
+          Else
-
+            lCurrent = lCurrent + lBytes
-    hLocal = OpenFile(sLocalFile, False)
+            RaiseEvent Progress(lCurrent, lSize, bCancel)
-    If hLocal = 0 Then
+            If bCancel Then
-        Exit Function
+              bRead = False
               bRet = False
-
+
-    If nMode = ffm_Ascii Then
+          End If
-        lMode = FTP_TRANSFER_TYPE_ASCII + FTP_TRANSFER_NO_CACHE
+
-    Else
+          bRead = False
-        lMode = FTP_TRANSFER_TYPE_BINARY + FTP_TRANSFER_NO_CACHE
+          bRet = True
         End If
-    Err.Clear
+      Else
-    hRemote = FtpOpenFile(mFTP.hConnect, sRemoteFile, GENERIC_WRITE, lMode, mFTP.hCtx)
+
-    If (hRemote = 0) Then
+        bRead = False
         bRet = False
-        Close #hLocal
+      End If
-        Exit Function
+
   End If
 
-
+  If bRet = True Then
-    lSize = FileLen(sLocalFile)
+    RaiseEvent Progress(lCurrent, lSize, bCancel)
-    RaiseEvent Progress(lCurrent, lSize)
+  End If
-
+  Call FtpCloseFile(hRemote)
-    ' loop: read from file and write to ftp
+  If bRet = True Then
     FtpResponse
   End If
   Close #hLocal
-        If lRemainder < 1024 Then
+
-            lBuff = lRemainder
+  DownloadFile = bRet
 End Function
-            lBuff = 1024
+
 ' .:::: upload (send) a file to ftp server
-        ReDim cbBuff(lBuff - 1)
+
-        lRemainder = lRemainder - lBuff
+  Dim lMode As FTP_TRANSFER_TYPE
-        Err.Clear
+  Dim hLocal As Long, hRemote As Long
-        Get #hLocal, , cbBuff
+  Dim lSizeLow As Long, lSizeHigh As Long
-        If Err.Number <> 0 Then
+  Dim lSize As Long, lCurrent As Long, lRemainder As Long
   Dim bRet As Boolean, bWrite As Boolean
   Dim cbBuff() As Byte, lBuff As Long, lBytes As Long
   Dim bCancel As Boolean
 
   On Local Error Resume Next
-            lBytes = 0
+  bRet = False
-            bWrite = FtpWriteFile(hRemote, cbBuff(0), lBuff, lBytes)
+  lCurrent = 0
-            If (bWrite <> False) Then
+  UploadFile = bRet
-                If (lBytes > 0) Then
+  DbgTrace "UploadFile " & sLocalFile & " -> " & sRemoteFile
-                    lCurrent = lCurrent + lBytes
+
-                    RaiseEvent Progress(lCurrent, lSize)
+  ' open local file for reading
-                Else
+  hLocal = OpenFile(sLocalFile, False)
-                    bWrite = False
+  If hLocal = 0 Then
-                    bRet = True
+
-                End If
+  End If
-                If lRemainder < 1 Then
+
-                    bWrite = False
+  ' open remote file for writing
-                    bRet = True
+  If nMode = ffm_Ascii Then
-                End If
+    lMode = FTP_TRANSFER_TYPE_ASCII
-            Else
+  Else
-                DecodeError
+    lMode = FTP_TRANSFER_TYPE_BINARY
-                bWrite = False
+  End If
-                bRet = False
+  lMode = lMode + FTP_TRANSFER_NO_CACHE
   Err.Clear
   hRemote = FtpOpenFile(mFTP.hConnect, sRemoteFile, GENERIC_WRITE, lMode, mFTP.hCtx)
   If (hRemote = 0) Then
-
+    DecodeError
-    If bRet = True Then
+
-        RaiseEvent Progress(lCurrent, lSize)
+
   End If
-    Call FtpCloseFile(hRemote)
+  FtpResponse
-    If bRet = True Then
+
-        FtpResponse
+  lSize = FileLen(sLocalFile)
   RaiseEvent Progress(lCurrent, lSize, bCancel)
 
-
+  ' loop: read from file and write to ftp
-    UploadFile = bRet
+  If Not bCancel Then
     bRet = False
     lRemainder = lSize
     Do
       ' read a chunk from local file
       If lRemainder < 1024 Then
         lBuff = lRemainder
       Else
         lBuff = 1024
-    Dim lSize As Long, lErrNo As Long, lRet As Long
+      End If
-    Dim hMod As Long
+      ReDim cbBuff(lBuff - 1)
-
+      lRemainder = lRemainder - lBuff
-    lErrNo = Err.LastDllError
+      Err.Clear
-    lSize = 2048
+      Get #hLocal, , cbBuff
-    mFTP.dwLastError = 0
+      If Err.Number <> 0 Then
         RaiseEvent Failure(Err.Number, Err.Description)
         DbgTrace "Error: " & Err.Number & " " & Err.Description
-    If (lRet <> 0) And (mFTP.dwLastError <> 0) Then
+        bWrite = False
-        mFTP.szLastError = GetSZ(mFTP.szLastError)
+        bRet = False
-    Else
+      Else
-        mFTP.dwLastError = lErrNo
+        ' write a chunk to remote file
-        mFTP.szLastError = ""
+
-        hMod = GetModuleHandle("wininet.dll")
+        bWrite = FtpWriteFile(hRemote, cbBuff(0), lBuff, lBytes)
-        If hMod <> 0 Then
+        If (bWrite <> False) Then
-            lSize = 2048
+          If (lBytes > 0) Then
-            mFTP.szLastError = String(lSize, vbNullChar)
+            lCurrent = lCurrent + lBytes
-            lRet = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, hMod, lErrNo, 0, mFTP.szLastError, lSize, 0)
+            RaiseEvent Progress(lCurrent, lSize, bCancel)
-            mFTP.dwLastError = lErrNo
+            If bCancel Then
-            mFTP.szLastError = GetSZ(mFTP.szLastError)
+              bWrite = False
               bRet = False
-        If Len(mFTP.szLastError) < 1 Then
+
-            mFTP.szLastError = "Unexpected error"
+          Else
             bWrite = False
             bRet = True
-    RaiseEvent Failure(mFTP.dwLastError, mFTP.szLastError)
+          End If
-    DbgTrace "Failure: " & mFTP.dwLastError & " " & mFTP.szLastError
+          If lRemainder < 1 Then
             bWrite = False
             bRet = True
           End If
         Else
-    Dim lSize As Long, lErrNo As Long
+          DecodeError
-    Dim lCode As Long, sData As String
+          bWrite = False
-    Dim vaData As Variant, iData As Long
+          bRet = False
-    Dim sMsg As String
+
-
+      End If
     Loop While (bWrite <> False)
-    lSize = 2048
+  End If
-    lCode = 0
+  If bRet = True Then
-    sData = String(lSize, vbNullChar)
+    RaiseEvent Progress(lCurrent, lSize, bCancel)
-    If InternetError(lCode, sData, lSize) Then
+  End If
-        sData = GetSZ(sData)
+  Call FtpCloseFile(hRemote)
-        vaData = Split(sData, vbCrLf)
+  If bRet = True Then
-        For iData = LBound(vaData) To UBound(vaData)
+
-            sMsg = Trim(Replace(vaData(iData), vbCr, " "))
+  End If
-            sMsg = Trim(Replace(sMsg, vbLf, " "))
+  Close #hLocal
-            If Len(sMsg) > 0 Then
+
-                RaiseEvent Message(sMsg)
+  UploadFile = bRet
-                DbgTrace "Message " & sMsg
+
 
-        Next iData
+
 ' :: Internal service functions - not visible from outer program
 ' :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
 ' ==== decode error and signal it
 Private Sub DecodeError()
   Dim lSize As Long, lErrNo As Long, lRet As Long
-    GetSZ = Mid(sBuff, 1, InStr(sBuff & vbNullChar, vbNullChar) - 1)
+  Dim hMod As Long
 
   lErrNo = Err.LastDllError
   lSize = 2048
   mFTP.dwLastError = 0
-    Dim tDATA As VB_FIND_DATA
+  If lErrNo = ERROR_INTERNET_EXTENDED_ERROR Then
-    Dim cTemp As Currency
+    ' got an FTP error message, try retrieving it
-    Dim st As SYSTEMTIME
+
-
+
   End If
-    With tDATA
+  If (lRet <> 0) And (mFTP.dwLastError <> 0) Then
-        If (tFIND.dwFileAttributes And vbDirectory) = 0 Then
+    ' got the message, go on
-            CopyMemory cTemp, tFIND.nFileSizeLow, 4
+    mFTP.szLastError = GetSZ(mFTP.szLastError)
-            CopyMemory ByVal VarPtr(cTemp) + 4, tFIND.nFileSizeHigh, 4
+  Else
-            .dFileSize = CDbl(cTemp) * 10000#
+    ' retrieve the message from system
     mFTP.dwLastError = lErrNo
-        FileTimeToSystemTime tFIND.ftLastWriteTime, st
+    mFTP.szLastError = ""
-        .dtLastWriteTime = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond) + (st.wMilliseconds / 86400000)
+    hMod = GetModuleHandle("wininet.dll")
-        .vFileAttributes = tFIND.dwFileAttributes
+    If hMod <> 0 Then
-        .sFileName = GetSZ(tFIND.cFileName)
+      lSize = 2048
-        .sAlternate = GetSZ(tFIND.cAlternate) ' <-- not used
+      mFTP.szLastError = String(lSize, vbNullChar)
-        RaiseEvent DirLine(.vFileAttributes, .dtLastWriteTime, .dFileSize, .sFileName)
+      lRet = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, hMod, lErrNo, 0, mFTP.szLastError, lSize, 0)
-        DbgTrace "DirLine " & Format(.dtLastWriteTime, "YYYY-MM-DD HH:NN:SS") & " " & Format(.dFileSize, "#,###,###,###,##0") & " " & .sFileName
+      mFTP.dwLastError = lErrNo
-    End With
+      mFTP.szLastError = GetSZ(mFTP.szLastError)
     End If
     If Len(mFTP.szLastError) < 1 Then
       ' unable to retrieve the error message
       mFTP.szLastError = "Unexpected error."
-    Dim cTemp As Currency
+
-
+  End If
   RaiseEvent Failure(mFTP.dwLastError, mFTP.szLastError)
-    CopyMemory cTemp, lSizeLow, 4
+  DbgTrace "Failure: " & mFTP.dwLastError & " " & mFTP.szLastError
-    CopyMemory ByVal VarPtr(cTemp) + 4, lSizeHigh, 4
+
-    DecodeSize = CDbl(cTemp) * 10000#
+
 ' ==== FTP responses
 Private Sub FtpResponse()
   Dim lSize As Long, lErrNo As Long
   Dim lCode As Long, sData As String
-    Dim hFile As Long, bRet As Boolean
+  Dim vaData As Variant, iData As Long
-
+  Dim sMsg As String
 
   On Local Error Resume Next
-    hFile = FreeFile
+  lSize = 2048
   lCode = 0
-        On Local Error Resume Next
+  sData = String(lSize, vbNullChar)
-        SetAttr sFileName, vbNormal
+  ' retrieve the FTP response
-        Kill sFileName
+  If InternetError(lCode, sData, lSize) Then
-        On Local Error GoTo Catch
+    ' response may be multiline, split it
-        Open sFileName For Binary Access Write Lock Read Write As #hFile
+    sData = GetSZ(sData)
-    Else
+    vaData = Split(sData, vbCrLf)
-        Open sFileName For Binary Access Read Lock Read Write As #hFile
+    ' loop over message lines
     For iData = LBound(vaData) To UBound(vaData)
-    bRet = True
+      sMsg = Trim(Replace(vaData(iData), vbCr, " "))
-
+      sMsg = Trim(Replace(sMsg, vbLf, " "))
       If Len(sMsg) > 0 Then
         RaiseEvent Message(sMsg)
-    If bRet = False Then
+        DbgTrace "Message " & sMsg
-        Close #hFile
+      End If
-        hFile = 0
+    Next iData
-        If bWrite Then
+  End If
-            Kill sFileName
+
 
 ' ==== cut an AsciiZ to its length
-    OpenFile = hFile
+
   On Local Error Resume Next
-
+  GetSZ = Mid(sBuff, 1, InStr(sBuff & vbNullChar, vbNullChar) - 1)
 End Function
-    RaiseEvent Failure(Err.Number, Err.Description)
+
-    DbgTrace "Error: " & Err.Number & " " & Err.Description
+
 Private Sub DecodeDirEntry(tFIND As WIN32_FIND_DATA)
-    Resume BailOut
+  Dim tDATA As VB_FIND_DATA
   Dim cTemp As Currency
   Dim st As SYSTEMTIME
 
   On Local Error Resume Next
-    Dim sTxt As String
+  With tDATA
-
+    ' if it's a regular file, calculate size
     If (tFIND.dwFileAttributes And vbDirectory) = 0 Then
-    If mbDebug = True Then
+      CopyMemory cTemp, tFIND.nFileSizeLow, 4
-        sTxt = "[" & App.EXEName & "][FTP] " & sMsg & vbCrLf
+      CopyMemory ByVal VarPtr(cTemp) + 4, tFIND.nFileSizeHigh, 4
-        Call OutputDebugString(sTxt)
+      .dFileSize = CDbl(cTemp) * 10000#
     End If
     ' convert file time and set other infos
     FileTimeToSystemTime tFIND.ftLastWriteTime, st
     .dtLastWriteTime = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond) + (st.wMilliseconds / 86400000)
     .vFileAttributes = tFIND.dwFileAttributes
     .sFileName = GetSZ(tFIND.cFileName)
     .sAlternate = GetSZ(tFIND.cAlternate) ' <-- not used
     RaiseEvent DirLine(.vFileAttributes, .dtLastWriteTime, .dFileSize, .sFileName)
     DbgTrace "DirLine " & Format(.dtLastWriteTime, "YYYY-MM-DD HH:NN:SS") & " " & Format(.dFileSize, "#,###,###,###,##0") & " " & .sFileName
   End With
 End Sub
 
 ' ==== decode a qword quantity
 Private Function DecodeSize(ByVal lSizeLow As Long, ByVal lSizeHigh As Long) As Double
   Dim cTemp As Currency
 
   On Local Error Resume Next
   CopyMemory cTemp, lSizeLow, 4
   CopyMemory ByVal VarPtr(cTemp) + 4, lSizeHigh, 4
   DecodeSize = CDbl(cTemp) * 10000#
 End Function
 
 ' ==== Open a file for read or write
 Private Function OpenFile(ByVal sFileName As String, Optional bWrite As Boolean = False) As Long
   Dim hFile As Long, bRet As Boolean
 
   On Local Error GoTo Catch
   bRet = False
   hFile = FreeFile
   If bWrite Then
     ' write mode, delete local file
     On Local Error Resume Next
     SetAttr sFileName, vbNormal
     Kill sFileName
     ' open file in binary write mode with exclusive access
     On Local Error GoTo Catch
     Open sFileName For Binary Access Write Lock Read Write As #hFile
   Else
     ' open file in binary read mode with exclusive access
     Open sFileName For Binary Access Read Lock Read Write As #hFile
   End If
   bRet = True
 
 BailOut:
   ' common exit point
   On Local Error Resume Next
   If bRet = False Then
     ' got an error
     Close #hFile
     hFile = 0
     If bWrite Then
       Kill sFileName
     End If
   End If
   OpenFile = hFile
   Exit Function
 
 Catch:
   ' error handler
   RaiseEvent Failure(Err.Number, Err.Description)
   DbgTrace "Error: " & Err.Number & " " & Err.Description
   bRet = False
   Resume BailOut
 End Function
 
 ' ==== writes a debug message
 Private Function DbgTrace(ByVal sMsg As String)
   Dim sTxt As String
 
   On Local Error Resume Next
   If mbDebug = True Then
     ' compose and emit the trace message
     Debug.Print sMsg
     sTxt = "[" & msAppName & "][FTP] " & sMsg & vbCrLf
     Call OutputDebugString(sTxt)
   End If
 End Function
 
 ' ==== gets the application name
 Private Function GetAppName() As String
   Dim nPos As Integer
   Dim sName As String
 
   sName = App.EXEName
   nPos = InStr(sName, ".")
   If nPos > 0 Then
     sName = Mid(sName, 1, nPos - 1)
   End If
   GetAppName = sName
 End Function