Ftp服务器

开发平台：
Visual Basic

CFtpConnection.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFtpConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'********************************************************************************
'CFtpConnection class
'Copyright 2000 by Oleg Gdalevich
'Visual Basic Internet Programming website (http://www.vbip.com)
'********************************************************************************
'To use this class module you need:
'   CFtpFile    class module
'   CFtpFiles   calss module
'   CTimeout    class module
'   MFtpSupport module
'
'   Also you need to set up the refernce to Winsock ActiveX Control
'   via REFERENCES dialog window. To do this, open Project References
'   dialog, click Browse button and select Mswinsck.ocx
'
'********************************************************************************
'Declarations of winsock objects.
'********************************************************************************
'Winsock Control for control connection
Private WithEvents wscControl As MSWinsockLib.Winsock
Attribute wscControl.VB_VarHelpID = -1
'Winsock Control for data connection
Private WithEvents wscData As MSWinsockLib.Winsock
Attribute wscData.VB_VarHelpID = -1
'********************************************************************************
'Local variables to hold values of the class properies
'********************************************************************************
Private m_strUserName           As String
Private m_strPassword           As String
Private m_varFtpServer          As Variant
Private m_strCurrentDirectory   As String
Private m_bPassiveMode          As Boolean
Private m_bBusy                 As Boolean
Private m_intTimeout            As Integer
Private m_TransferMode          As FtpTransferModes
'********************************************************************************
'Public Enums
'********************************************************************************
'various states of ftp connection
Public Enum FTP_CONNECTION_STATES
    FTP_CONNECTION_RESOLVING_HOST
    FTP_CONNECTION_HOST_RESOLVED
    FTP_CONNECTION_CONNECTED
    FTP_CONNECTION_AUTHENTICATION
    FTP_USER_LOGGED
    FTP_ESTABLISHING_DATA_CONNECTION
    FTP_DATA_CONNECTION_ESTABLISHED
    FTP_RETRIEVING_DIRECTORY_INFO
    FTP_DIRECTORY_INFO_COMPLETED
    FTP_TRANSFER_STARTING
    FTP_TRANSFER_COMLETED
End Enum
'all possible reply codes that can be sent by ftp server
Private Enum FTP_RESPONSE_CODES
    FTP_RESPONSE_RESTATRT_MARKER_REPLY = 110
    FTP_RESPONSE_SERVICE_READY_IN_MINUTES = 120
    FTP_RESPONSE_DATA_CONNECTION_ALREADY_OPEN = 125
    FTP_RESPONSE_FILE_STATUS_OK = 150
    FTP_RESPONSE_COMMAND_OK = 200
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_SUPERFLUOUS_AT_THIS_SITE = 202 'superfluous at this site
    FTP_RESPONSE_SYSTEM_STATUS_OR_SYSTEM_HELP_REPLY = 211
    FTP_RESPONSE_DIRECTORY_STATUS = 212
    FTP_RESPONSE_FILE_STATUS = 213
    FTP_RESPONSE_HELP_MESSAGE = 214
    FTP_RESPONSE_NAME_SYSTEM_TYPE = 215
    FTP_RESPONSE_SERVICE_READY_FOR_NEW_USER = 220
    FTP_RESPONSE_SERVICE_CLOSING_CONTROL_CONNECTION = 221
    FTP_RESPONSE_DATA_CONNECTION_OPEN = 225
    FTP_RESPONSE_CLOSING_DATA_CONNECTION = 226
    FTP_RESPONSE_ENTERING_PASSIVE_MODE = 227
    FTP_RESPONSE_USER_LOGGED_IN = 230
    FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED = 250
    FTP_RESPONSE_PATHNAME_CREATED = 257
    FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD = 331
    FTP_RESPONSE_NEED_ACCOUNT_FOR_LOGIN = 332
    FTP_RESPONSE_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO = 350
    FTP_RESPONSE_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION = 421
    FTP_RESPONSE_CANNOT_OPEN_DATA_CONNECTION = 425
    FTP_RESPONSE_CONNECTION_CLOSED_TRANSFER_ABORTED = 426
    FTP_RESPONSE_REQUESTED_FILE_ACTION_NOT_TAKEN = 450
    FTP_RESPONSE_REQUESTED_ACTION_ABORTED = 451
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN = 452
    FTP_RESPONSE_SYNTAX_ERROR_COMMAND_UNRECOGNIZED = 500
    FTP_RESPONSE_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS = 501
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED = 502
    FTP_RESPONSE_BAD_SEQUENCE_OF_COMMANDS = 503
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER = 504
    FTP_RESPONSE_NOT_LOGGED_IN = 530
    FTP_RESPONSE_NEED_ACCOUNT_FOR_STORING_FILES = 532
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE = 550
    FTP_RESPONSE_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN = 551
    FTP_RESPONSE_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION = 552
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED = 553
End Enum
'transfer modes
Public Enum FtpTransferModes
    FTP_ASCII_MODE
    FTP_IMAGE_MODE
End Enum
'********************************************************************************
'Class errors
'********************************************************************************
Public Enum FtpErrors
    ERROR_FTP_WINSOCK_AddressInUse
    ERROR_FTP_WINSOCK_AddressNotAvailable
    ERROR_FTP_WINSOCK_AlreadyComplete
    ERROR_FTP_WINSOCK_AlreadyConnected
    ERROR_FTP_WINSOCK_BadState
    ERROR_FTP_WINSOCK_ConnectAborted
    ERROR_FTP_WINSOCK_ConnectionRefused
    ERROR_FTP_WINSOCK_ConnectionReset
    ERROR_FTP_WINSOCK_GetNotSupported
    ERROR_FTP_WINSOCK_HostNotFound
    ERROR_FTP_WINSOCK_HostNotFoundTryAgain
    ERROR_FTP_WINSOCK_InProgress
    ERROR_FTP_WINSOCK_InvalidArg
    ERROR_FTP_WINSOCK_InvalidArgument
    ERROR_FTP_WINSOCK_InvalidOp
    ERROR_FTP_WINSOCK_InvalidPropertyValue
    ERROR_FTP_WINSOCK_MsgTooBig
    ERROR_FTP_WINSOCK_NetReset
    ERROR_FTP_WINSOCK_NetworkSubsystemFailed
    ERROR_FTP_WINSOCK_NetworkUnreachable
    ERROR_FTP_WINSOCK_NoBufferSpace
    ERROR_FTP_WINSOCK_NoData
    ERROR_FTP_WINSOCK_NonRecoverableError
    ERROR_FTP_WINSOCK_NotConnected
    ERROR_FTP_WINSOCK_NotInitialized
    ERROR_FTP_WINSOCK_NotSocket
    ERROR_FTP_WINSOCK_OpCanceled
    ERROR_FTP_WINSOCK_OutOfMemory
    ERROR_FTP_WINSOCK_OutOfRange
    ERROR_FTP_WINSOCK_PortNotSupported
    ERROR_FTP_WINSOCK_SetNotSupported
    ERROR_FTP_WINSOCK_SocketShutdown
    ERROR_FTP_WINSOCK_Success
    ERROR_FTP_WINSOCK_Timedout
    ERROR_FTP_WINSOCK_Unsupported
    ERROR_FTP_WINSOCK_WouldBlock
    ERROR_FTP_WINSOCK_WrongProtocol
    ERROR_FTP_PROTOCOL_SERVICE_READY_IN_MINUTES
    ERROR_FTP_PROTOCOL_USER_NAME_OK_NEED_PASSWORD
    ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_LOGIN
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO
    ERROR_FTP_PROTOCOL_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
    ERROR_FTP_PROTOCOL_CANNOT_OPEN_DATA_CONNECTION
    ERROR_FTP_PROTOCOL_CONNECTION_CLOSED_TRANSFER_ABORTED
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_NOT_TAKEN
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN
    ERROR_FTP_PROTOCOL_SYNTAX_ERROR_COMMAND_UNRECOGNIZED
    ERROR_FTP_PROTOCOL_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS
    ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED
    ERROR_FTP_PROTOCOL_BAD_SEQUENCE_OF_COMMANDS
    ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER
    ERROR_FTP_PROTOCOL_NOT_LOGGED_IN
    ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_STORING_FILES
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED
    ERROR_FTP_USER_TIMEOUT
    ERROR_FTP_USER_TRANSFER_IN_PROGRESS
End Enum
'********************************************************************************
'Class events
'********************************************************************************
Public Event StateChanged(State As FTP_CONNECTION_STATES)
Public Event DownloadProgress(lBytes As Long)
Public Event UploadProgress(lBytes As Long)
'********************************************************************************
'Service constants and variables used inside the class
'********************************************************************************
Const RESPONSE_CODE_LENGHT = 3
Private m_LastError             As FtpErrors
Private m_strLastErrorDesc      As String
Private m_strWinsockBuffer      As String
Private m_strDataBuffer         As String
Private m_strLocalFilePath      As String
Private m_intLocalFileID        As Integer
Private m_bTransferInProgress   As Boolean
Private m_lDownloadedBytes      As Long
Private m_bUploadFile           As Boolean
Private m_lUploadedBytes        As Long
Private m_strLastServerResponse As String
Private m_objTimeOut            As CTimeout
Private m_bFileIsOpened         As Boolean
'
Public Function FtpGetLastError() As FtpErrors
    FtpGetLastError = m_LastError
End Function
Public Function CurrentDirectory() As String
    CurrentDirectory = m_strCurrentDirectory
End Function
Public Function GetLastServerResponse() As String
    GetLastServerResponse = m_strLastServerResponse
End Function
Public Property Get TransferMode() As FtpTransferModes
    TransferMode = m_TransferMode
End Property
Public Property Let TransferMode(NewValue As FtpTransferModes)
    
    m_bBusy = True
    If Not (NewValue = m_TransferMode) Then
        If ProcessTYPECommand(NewValue) Then
            m_TransferMode = NewValue
        End If
    End If
    m_bBusy = False
End Property
Private Function ProcessLISTCommand() As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :07.01.00
'Purpose     :
'********************************************************************************
On Error GoTo ProcessLISTCommand_Err_Handler
    Dim strResponse As String
    Dim strData     As String
    wscControl.SendData "LIST" & vbCrLf
    Debug.Print "LIST"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            If GetResponseCode(m_strWinsockBuffer) = 150 Or _
                GetResponseCode(m_strWinsockBuffer) = 125 Then
                'ignore 150 reply code
                m_strWinsockBuffer = Mid$(m_strWinsockBuffer, InStr(1, m_strWinsockBuffer, vbCrLf) + 2)
            Else
                strData = m_strWinsockBuffer
                m_strWinsockBuffer = ""
                Exit Do
            End If
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Or _
        GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        
        ProcessLISTCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessLISTCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessLISTCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Public Property Get PassiveMode() As Boolean
    PassiveMode = m_bPassiveMode
End Property
Public Property Let PassiveMode(NewValue As Boolean)
    m_bPassiveMode = NewValue
End Property
Public Function EnumFiles(oFiles As CFtpFiles) As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :07.01.00
'Purpose     :Enumerates the files and dirs in the current directory
'********************************************************************************
Dim bDataConnectionEstablished As Boolean
'On Error GoTo EnumFiles_Err_Handler
    m_bBusy = True
    If m_bPassiveMode Then
        'send PASV command
        bDataConnectionEstablished = ProcessPASVCommand
    Else
        'send PORT command
        bDataConnectionEstablished = ProcessPORTCommand
    End If 'm_bPassiveMode
    '
    If bDataConnectionEstablished Then
        RaiseEvent StateChanged(FTP_RETRIEVING_DIRECTORY_INFO)
        If ProcessLISTCommand Then
            m_objTimeOut.StartTimer
            Do
                DoEvents
                '
                If m_objTimeOut.Timeout Then
                    m_LastError = ERROR_FTP_USER_TIMEOUT
                    If GetResponseCode(Left(m_strLastServerResponse, 3)) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Then
                        Set oFiles = GetFileList(m_strDataBuffer)
                        EnumFiles = True
                        RaiseEvent StateChanged(FTP_DIRECTORY_INFO_COMPLETED)
                        m_strDataBuffer = ""
                    End If
                    Exit Do
                End If
                '
                If wscData.State = sckClosing Or wscData.State = sckClosed Then
                    Set oFiles = Nothing
                    Set oFiles = GetFileList(m_strDataBuffer)
                    EnumFiles = True
                    RaiseEvent StateChanged(FTP_DIRECTORY_INFO_COMPLETED)
                    m_strDataBuffer = ""
                    Exit Do
                End If
            Loop
            m_objTimeOut.StopTimer
        Else
            'raise error - LIST command
        End If 'ProcessLISTCommand
    Else 'bDataConnectionEstablished
        'raise error - can't establish data connection
    End If 'bDataConnectionEstablished
Exit_Label:
    m_bBusy = False
    Exit Function
EnumFiles_Err_Handler:
    Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.EnumFiles", Err.Description
    GoTo Exit_Label
End Function
Public Function SetCurrentDirectory(strNewDirectory As String) As Boolean
    m_bBusy = True
    SetCurrentDirectory = ProcessCWDCommand(strNewDirectory)
    m_bBusy = False
    
End Function
Public Property Get FtpServer() As Variant
    FtpServer = m_varFtpServer
End Property
Public Property Let FtpServer(NewValue As Variant)
    m_varFtpServer = NewValue
End Property
Public Property Get Password() As String
    Password = m_strPassword
End Property
Public Property Let Password(NewValue As String)
    m_strPassword = NewValue
End Property
Public Property Get UserName() As String
    UserName = m_strUserName
End Property
Public Property Let UserName(NewValue As String)
    m_strUserName = NewValue
End Property
Public Function Connect() As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :28.12.99
'Purpose     :Establishes the connection to ftp server
'********************************************************************************
On Error GoTo Connect_Err_Handler
Dim strData     As String
m_strWinsockBuffer = ""
m_bBusy = True
If Len(m_varFtpServer) > 0 Then
    With wscControl
        .Close
        .LocalPort = 0
        .Connect m_varFtpServer, 21
        m_objTimeOut.StartTimer
        Do
            DoEvents
            '
            If m_objTimeOut.Timeout Then
                m_LastError = ERROR_FTP_USER_TIMEOUT
                Exit Do
            End If
            '
            If .State = sckConnected Then
                m_objTimeOut.StopTimer
                RaiseEvent StateChanged(FTP_CONNECTION_CONNECTED)
                m_objTimeOut.StartTimer
                Do
                    DoEvents
                    '
                    If m_objTimeOut.Timeout Then
                        m_LastError = ERROR_FTP_USER_TIMEOUT
                        Exit Do
                    End If
                    '
                    If Len(m_strWinsockBuffer) > (RESPONSE_CODE_LENGHT - 1) Then
                        strData = m_strWinsockBuffer
                        m_strWinsockBuffer = ""
                        Exit Do
                    End If
                Loop
                m_objTimeOut.StopTimer
                Select Case GetResponseCode(strData)
                    Case FTP_RESPONSE_SERVICE_READY_FOR_NEW_USER
                        Select Case ProcessUSERCommand
                            Case FTP_RESPONSE_USER_LOGGED_IN
                                Connect = True
                            Case FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD
                                If ProcessPASSCommand = FTP_RESPONSE_USER_LOGGED_IN Then
                                    Connect = True
                                End If
                        End Select
                        'Get working directory
                        If Connect Then
                            Call ProcessPWDCommand
                        End If
                    Case FTP_RESPONSE_SERVICE_READY_IN_MINUTES
                        '120 Service ready in nnn minutes.
                        m_LastError = ERROR_FTP_PROTOCOL_SERVICE_READY_IN_MINUTES
                    Case FTP_RESPONSE_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
                        '421 Service not available, closing control connection.
                        m_LastError = ERROR_FTP_PROTOCOL_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
                End Select
                Exit Do
            ElseIf .State = sckConnectAborted Then
                m_LastError = ERROR_FTP_WINSOCK_ConnectAborted
            ElseIf .State = sckResolvingHost Then
                RaiseEvent StateChanged(FTP_CONNECTION_RESOLVING_HOST)
            ElseIf .State = sckHostResolved Then
                RaiseEvent StateChanged(FTP_CONNECTION_HOST_RESOLVED)
            End If
        Loop
        m_objTimeOut.StopTimer
    End With
Else
    'raise error
    Connect = False
    Exit Function
End If
Exit_Label:
    If Connect Then RaiseEvent StateChanged(FTP_USER_LOGGED)
    m_bBusy = False
    Exit Function
Connect_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.Connect", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Sub Class_Initialize()
    Set wscControl = New MSWinsockLib.Winsock
    Set wscData = New MSWinsockLib.Winsock
    Set m_objTimeOut = New CTimeout
End Sub
Private Function GetResponseCode(strResponse As String) As Integer
    If Len(strResponse) > (RESPONSE_CODE_LENGHT - 1) Then
        GetResponseCode = CInt(Left$(strResponse, 3))
    End If
        
End Function
Private Function ProcessUSERCommand() As FTP_RESPONSE_CODES
    Dim strData     As String
    
    On Error GoTo ProcessUSERCommand_Err_Handler
    
    RaiseEvent StateChanged(FTP_CONNECTION_AUTHENTICATION)
    m_strUserName = IIf(Len(m_strUserName) > 0, m_strUserName, "anonymous")
    
    If Len(m_strPassword) = 0 Then
        If m_strUserName = "anonymous" Then
            m_strPassword = "guest@unknown.com"
        Else
            'raise error
            Exit Function
        End If
    End If
    
    wscControl.SendData "USER " & m_strUserName & vbCrLf
    Debug.Print "USER " & m_strUserName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If Len(m_strWinsockBuffer) > RESPONSE_CODE_LENGHT Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    Select Case GetResponseCode(strData)
        Case FTP_RESPONSE_USER_LOGGED_IN
            ProcessUSERCommand = FTP_RESPONSE_USER_LOGGED_IN
        Case FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD
            ProcessUSERCommand = FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD
        Case Else
            ProcessFtpResponse GetResponseCode(strData)
    End Select
    
Exit_Label:
    Exit Function
ProcessUSERCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessUSERCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessPASSCommand() As FTP_RESPONSE_CODES
    Dim strResponse As String
    Dim strData     As String
    '
    On Error GoTo ProcessPASSCommand_Err_Handler
    wscControl.SendData "PASS " & m_strPassword & vbCrLf
    Debug.Print "PASS " & m_strPassword
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If Len(m_strWinsockBuffer) > RESPONSE_CODE_LENGHT Then
            strData = m_strWinsockBuffer
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_USER_LOGGED_IN Then
        Do
            DoEvents
            If InStr(1, m_strWinsockBuffer, "230 ") > 0 Then
                ProcessPASSCommand = FTP_RESPONSE_USER_LOGGED_IN
                m_strWinsockBuffer = ""
                Exit Function
            End If
        Loop
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    ProcessPASSCommand = GetResponseCode(strData)
    
Exit_Label:
    Exit Function
ProcessPASSCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessPASSCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessPWDCommand() As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessPWDCommand_Err_Handler
    wscControl.SendData "PWD" & vbCrLf
    Debug.Print "PWD"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_PATHNAME_CREATED Then
        Dim intPosA As Integer, intPosB As Integer
        intPosA = InStr(1, strData, Chr$(34)) + 1
        intPosB = InStr(intPosA, strData, Chr$(34))
        If intPosA > 1 And intPosB > 0 Then
            m_strCurrentDirectory = Mid$(strData, intPosA, intPosB - intPosA)
            ProcessPWDCommand = True
        Else
            'raise error - unknown response format
        End If
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessPWDCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessPWDCommand", Err.Description
    End If
    GoTo Exit_Label
        
End Function
Private Sub Class_Terminate()
    
    Call BreakeConnection
    Set wscData = Nothing
    Set wscControl = Nothing
    
    m_objTimeOut.StopTimer
    Set m_objTimeOut = Nothing
    
End Sub
Private Sub wscControl_DataArrival(ByVal bytesTotal As Long)
    
    Dim strData As String
    
    wscControl.GetData strData
    m_strWinsockBuffer = m_strWinsockBuffer & strData
    m_strLastServerResponse = strData
    m_objTimeOut.Reset
    
    
    If GetResponseCode(strData) = 426 Then
        If m_bTransferInProgress Or m_bUploadFile Then
            wscData.Close
            Close m_intLocalFileID
            m_strDataBuffer = ""
            m_lDownloadedBytes = 0
            m_lUploadedBytes = 0
            m_bTransferInProgress = False
            m_bUploadFile = False
            m_bFileIsOpened = False
        End If
        wscControl.Close
        m_bBusy = False
    End If
    
    Debug.Print Left(strData, Len(strData) - 2)
    
End Sub
Private Function ProcessPORTCommand() As Boolean
    Dim intPort         As Integer
    Dim strIPAddress    As String
    Dim colIPAddresses  As New Collection
    Dim strSend         As String
    Dim strData         As String
    
    On Error Resume Next
    
    RaiseEvent StateChanged(FTP_ESTABLISHING_DATA_CONNECTION)
    
    Do
        intPort = GetFreePort
        If wscData.State <> sckClosed Then wscData.Close
        wscData.LocalPort = intPort
        wscData.Listen
        If Not Err Then Exit Do
    Loop
    
    On Error GoTo ProcessPORTCommand_Err_Handler
    '
    strIPAddress = CStr(wscControl.LocalIP)
    '
    strSend = "PORT " & Replace(strIPAddress, ".", ",")
    strSend = strSend & "," & intPort  256 & "," & (intPort Mod 256)
    '
    strSend = strSend & vbCrLf
    '
    wscControl.SendData strSend
    Debug.Print Left(strSend, Len(strSend) - 2)
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_COMMAND_OK Then
        ProcessPORTCommand = True
        RaiseEvent StateChanged(FTP_DATA_CONNECTION_ESTABLISHED)
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessPORTCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessPORTCommand", Err.Description
    End If
    GoTo Exit_Label
        
End Function
Private Function GetFreePort() As Integer
    
    Static intPort As Integer
    
    If intPort = 0 Then
        intPort = 1100
    Else
        intPort = intPort + 1
    End If
    
    GetFreePort = intPort
    
End Function
Private Sub wscData_ConnectionRequest(ByVal requestID As Long)
    
    If wscData.State <> sckClosed Then wscData.Close
    
    wscData.Accept (requestID)
    
End Sub
Private Sub wscData_DataArrival(ByVal bytesTotal As Long)
    
    Dim strData As String
    
    wscData.GetData strData
    
    If m_bTransferInProgress Then
        If m_bFileIsOpened Then
            '
            'write data to local file
            '
            Put m_intLocalFileID, , strData
            '
            'raise DownloadProgress event
            '
            m_lDownloadedBytes = m_lDownloadedBytes + bytesTotal
            RaiseEvent DownloadProgress(m_lDownloadedBytes)
        End If
    Else
        m_strDataBuffer = m_strDataBuffer & strData
'        Debug.Print strData
    End If
    
    m_objTimeOut.Reset
End Sub
Public Function RenameFile(strOldFileName As String, strNewFileName As String) As Boolean
    
    m_bBusy = True
    If ProcessRNFRCommand(strOldFileName) Then
        If ProcessRNTOCommand(strNewFileName) Then
            RenameFile = True
        End If
    End If
    m_bBusy = False
End Function
Public Function DeleteFile(strFileName As String) As Boolean
    
    m_bBusy = True
    DeleteFile = ProcessDELECommand(strFileName)
    m_bBusy = False
End Function
Public Function RemoveDirectory(strDirName As String) As Boolean
    
    m_bBusy = True
    RemoveDirectory = ProcessRMDCommand(strDirName)
    m_bBusy = False
    
End Function
Public Function CreateDirectory(strDirName As String) As Boolean
    
    m_bBusy = True
    CreateDirectory = ProcessMKDCommand(strDirName)
    m_bBusy = False
    
End Function
Private Function GetFileList(strListing As String) As CFtpFiles
    '
    Dim vFiles      As Variant
    Dim vFile       As Variant
    Dim vComponents As Variant
    Dim oFtpFile    As CFtpFile
    Dim oFtpFiles   As New CFtpFiles
    
    On Error Resume Next
    '
    Set GetFileList = Nothing
    '
    vFiles = Split(strListing, vbCrLf)
    '
    For Each vFile In vFiles
        Set oFtpFile = New CFtpFile
        '
        'replace multiple whitespaces with single whitespace
        '
        For i = 15 To 2 Step -1
            vFile = Replace(vFile, Space(i), " ")
        Next
        '
        If Len(vFile) > 0 Then
            If Not LCase(Left(vFile, 5)) = "total" Then
                vComponents = Split(vFile, " ")
                If UBound(vComponents) > 7 Then
                    With oFtpFile
                        If Left(vComponents(0), 1) = "d" Then
                            oFtpFile.IsDirectory = True
                        ElseIf Left(vFile, 1) = "l" Then
                            .FilePath = vComponents(10)
                            If Not CBool(InStr(InStrRev(vComponents(10), "/") + 1, vComponents(10), ".")) Then
                                .IsDirectory = True
                            End If
                        End If
                        .FileSize = vComponents(4)
                        .FileName = vComponents(8)
                        .LastWriteTime = GetDate(vComponents(6), vComponents(5), vComponents(7))
                        If Not (.FileName = "." Or .FileName = "..") Then
                            oFtpFiles.Add oFtpFile, oFtpFile.FileName
                        End If
                    End With
                Else
                    With oFtpFile
                        If vComponents(2) = "<DIR>" Then
                            .IsDirectory = True
                        Else
                            .FileSize = CLng(vComponents(2))
                        End If
                        If UBound(vComponents) > 3 Then
                            Dim strFile As String
                            For i = 3 To UBound(vComponents)
                               strFile = strFile & " " & vComponents(i)
                            Next i
                            strFile = Mid$(strFile, 2)
                        Else
                            strFile = vComponents(3)
                        End If
                        .FileName = strFile
                        .LastWriteTime = CDate(vComponents(0) & " " & vComponents(1))
                        oFtpFiles.Add oFtpFile, oFtpFile.FileName
                    End With
                End If
                Set oFtpFile = Nothing
            End If
        End If
        strFile = ""
    Next
    
    Set GetFileList = oFtpFiles
    Set oFtpFiles = Nothing
    
End Function
Private Function GetDate(vDay, vMonth, vYear) As Date
    vYear = IIf(InStr(1, vYear, ":"), Year(Now), vYear)
    
    Select Case vMonth
        Case "Jan": vMonth = 1
        Case "Feb": vMonth = 2
        Case "Mar": vMonth = 3
        Case "Apr": vMonth = 4
        Case "May": vMonth = 5
        Case "Jun": vMonth = 6
        Case "Jul": vMonth = 7
        Case "Aug": vMonth = 8
        Case "Sep": vMonth = 9
        Case "Oct": vMonth = 10
        Case "Nov": vMonth = 11
        Case "Dec": vMonth = 12
    End Select
    
    GetDate = DateSerial(CInt(vYear), CInt(vMonth), CInt(vDay))
End Function
Private Function ProcessPASVCommand() As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessPASVCommand_Err_Handler
    
    RaiseEvent StateChanged(FTP_ESTABLISHING_DATA_CONNECTION)
    wscControl.SendData "PASV" & vbCrLf
    Debug.Print "PASV"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_ENTERING_PASSIVE_MODE Then
        ProcessPASVCommand = MakePassiveDataConnection(strData)
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
Exit_Label:
    Exit Function
ProcessPASVCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessPASVCommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Private Function MakePassiveDataConnection(sData As String) As Boolean
    '
    'Example of the string passed with sData argument
    '227 Entering Passive Mode (194,220,224,2,7,189)
    '
    Dim iPos            As Integer
    Dim iPos2           As Integer
    Dim strDataAddress  As String
    Dim strIP           As String
    Dim lPort           As Long
    '
    On Error GoTo MakePassiveDataConnection_Err_Handler
    '
    iPos = InStr(1, sData, "(") + 1
    If Not CBool(iPos) Then Exit Function
    strDataAddress = Mid$(sData, iPos, InStr(1, sData, ")") - iPos)
    strDataAddress = Replace(strDataAddress, ",", ".", 1, 3)
    iPos = InStr(1, strDataAddress, ",")
    strIP = Left$(strDataAddress, iPos - 1)
    lPort = CLng(Mid$(strDataAddress, iPos + 1, InStr(iPos + 1, strDataAddress, ",") - iPos))
    lPort = lPort * 256
    lPort = lPort + CLng(Mid$(strDataAddress, InStrRev(strDataAddress, ",") + 1))
    
    wscData.Close
    wscData.LocalPort = 0
    wscData.Connect strIP, lPort
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If wscData.State = sckConnected Then
            MakePassiveDataConnection = True
            RaiseEvent StateChanged(FTP_DATA_CONNECTION_ESTABLISHED)
            Debug.Print "Connecting to: " & strIP & ":" & lPort
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
Exit_Label:
    Exit Function
    
MakePassiveDataConnection_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.MakePassiveDataConnection", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Public Function DownloadFile(strFileName As String, strLocalFileName As String, vTransferMode As FtpTransferModes, Optional lStartPoint As Long) As Boolean
    Dim bDataConnectionEstablished As Boolean
    
    m_bBusy = True
    
    If ProcessTYPECommand(vTransferMode) Then
        m_TransferMode = vTransferMode
    Else
        Exit Function
    End If
    
    If m_bPassiveMode Then
        bDataConnectionEstablished = ProcessPASVCommand
    Else
        bDataConnectionEstablished = ProcessPORTCommand
    End If
    
    If bDataConnectionEstablished Then
        If lStartPoint > 0 Then
            m_lDownloadedBytes = lStartPoint
            If Not ProcessRESTCommand(lStartPoint) Then
                'can't restart download
                DownloadFile = False
                Exit Function
            End If
        End If
        m_bTransferInProgress = True
        m_strLocalFilePath = strLocalFileName
        If ProcessRETRCommand(strFileName, lStartPoint) Then
            m_objTimeOut.StartTimer
            Do
                DoEvents
                '
                If m_objTimeOut.Timeout Then
                    m_LastError = ERROR_FTP_USER_TIMEOUT
                    Exit Do
                End If
                '
                If wscData.State = sckClosed Or wscData.State = sckClosing Then
                    RaiseEvent StateChanged(FTP_TRANSFER_COMLETED)
                    'close file
                    Close #m_intLocalFileID
                    m_bFileIsOpened = False
                    m_bTransferInProgress = False
                    m_lDownloadedBytes = 0
                    If Left$(GetLastServerResponse, 3) = "426" Then
                        m_LastError = FTP_RESPONSE_CONNECTION_CLOSED_TRANSFER_ABORTED
                        Call ProcessFtpResponse(FTP_RESPONSE_CONNECTION_CLOSED_TRANSFER_ABORTED)
                        DownloadFile = False
                    Else
                        DownloadFile = True
                    End If
                    Exit Do
                End If
            Loop
            m_objTimeOut.StopTimer
        Else
            DownloadFile = False
            m_bTransferInProgress = False
            Close m_intLocalFileID
        End If
    End If
    
    m_bBusy = False
End Function
Private Function ProcessRETRCommand(strFileName As String, lStartPoint As Long) As Boolean
    
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRETRCommand_Err_Handler
    
    m_strDataBuffer = ""
    wscControl.SendData "RETR " & strFileName & vbCrLf
    Debug.Print "RETR " & strFileName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If Not m_bTransferInProgress Then
            strData = m_strWinsockBuffer
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            If GetResponseCode(m_strWinsockBuffer) = 150 Or _
                GetResponseCode(m_strWinsockBuffer) = 125 Then
                If lStartPoint = 0 And FileExists(m_strLocalFilePath) Then
                    Kill m_strLocalFilePath
                End If
                m_intLocalFileID = FreeFile
                Open m_strLocalFilePath For Binary As m_intLocalFileID
                If lStartPoint > 0 Then
                    Seek m_intLocalFileID, lStartPoint + 1
                End If
                'turn on flag m_bFileIsOpened
                m_bFileIsOpened = True
                'ignore 150 and 125 reply codes
                m_strWinsockBuffer = Mid$(m_strWinsockBuffer, InStr(1, m_strWinsockBuffer, vbCrLf) + 2)
                RaiseEvent StateChanged(FTP_TRANSFER_STARTING)
            Else
                strData = m_strWinsockBuffer
                m_strWinsockBuffer = ""
                Exit Do
            End If
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Or _
        GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessRETRCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessRETRCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessRETRCommand", Err.Description
    End If
    GoTo Exit_Label
        
End Function
Private Function ProcessRESTCommand(lStartPoint As Long) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRESTCommand_Err_Handler
    
    wscControl.SendData "REST " & lStartPoint & vbCrLf
    Debug.Print "REST " & lStartPoint
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO Then
        ProcessRESTCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessRESTCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessRESTCommand", Err.Description
    End If
    GoTo Exit_Label
        
End Function
Public Sub BreakeConnection()
    
    On Error Resume Next
    
    If wscData <> sckClosed Then
        wscData.Close
    Else
        wscControl.Close
    End If
    
    If m_bTransferInProgress Or m_bUploadFile Then
        Close m_intLocalFileID
        m_strDataBuffer = ""
        m_lDownloadedBytes = 0
        m_lUploadedBytes = 0
        m_bTransferInProgress = False
        m_bUploadFile = False
    End If
    m_bFileIsOpened = False
    m_bBusy = False
    m_objTimeOut.StopTimer
    
End Sub
Private Function ProcessTYPECommand(vType As FtpTransferModes) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessTYPECommand_Err_Handler
    
    wscControl.SendData "TYPE " & IIf(vType = FTP_ASCII_MODE, "A", "I") & vbCrLf
    Debug.Print "TYPE " & IIf(vType = FTP_ASCII_MODE, "A", "I")
    
    m_objTimeOut.StartTimer
    Do
           DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_COMMAND_OK Then
        ProcessTYPECommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessTYPECommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessTYPECommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function FileExists(strFileName As String) As Boolean
    
    On Error GoTo ERROR_HANDLER
    
    FileExists = (GetAttr(strFileName) And vbDirectory) = 0
ERROR_HANDLER:
    
End Function
Private Function ProcessDELECommand(strFileName As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    '
    On Error GoTo ProcessDELECommand_Err_Handler
    
    wscControl.SendData "DELE " & strFileName & vbCrLf
    Debug.Print "DELE " & strFileName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessDELECommand = True
    Else
        ProcessFtpResponse (GetResponseCode(strData))
    End If
    
Exit_Label:
    Exit Function
    
ProcessDELECommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessDELECommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Private Function ProcessMKDCommand(strDirName As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    '
    On Error GoTo ProcessMKDCommand_Err_Handler
    
    wscControl.SendData "MKD " & strDirName & vbCrLf
    Debug.Print "MKD " & strDirName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_PATHNAME_CREATED Then
        ProcessMKDCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
Exit_Label:
    Exit Function
ProcessMKDCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessMKDCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessRMDCommand(strDirName As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRMDCommand_Err_Handler
    
    wscControl.SendData "RMD " & strDirName & vbCrLf
    Debug.Print "RMD " & strDirName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessRMDCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessRMDCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessRMDCommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Private Function ProcessRNFRCommand(strFileName As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRNFRCommand_Err_Handler
    
    wscControl.SendData "RNFR " & strFileName & vbCrLf
    Debug.Print "RNFR " & strFileName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO Then
        ProcessRNFRCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
Exit_Label:
    Exit Function
ProcessRNFRCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessRNFRCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessRNTOCommand(strFileName As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRNTOCommand_Err_Handler
    
    wscControl.SendData "RNTO " & strFileName & vbCrLf
    Debug.Print "RNTO " & strFileName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessRNTOCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessRNTOCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessRNTOCommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Public Function UploadFile(strLocalFileName As String, strRemoteFileName As String, vTransferMode As FtpTransferModes, Optional lStartPoint As Long) As Boolean
    Dim bDataConnectionEstablished As Boolean
        
    m_bBusy = True
        
    If Not (vTransferMode = m_TransferMode) Then
        If ProcessTYPECommand(vTransferMode) Then
            m_TransferMode = vTransferMode
        Else
            Exit Function
        End If
    End If
    
    If m_bPassiveMode Then
        bDataConnectionEstablished = ProcessPASVCommand
    Else
        bDataConnectionEstablished = ProcessPORTCommand
    End If
    
    If bDataConnectionEstablished Then
        '
        If Not IsMissing(lStartPoint) Then
            If Not ProcessRESTCommand(lStartPoint) Then
                UploadFile = False
                Exit Function
            End If
        End If
        '
        m_strLocalFilePath = strLocalFileName
        m_bUploadFile = True
        If ProcessSTORCommand(strLocalFileName, strRemoteFileName, lStartPoint) Then
            m_objTimeOut.StartTimer
            Do
                DoEvents
                '
                If m_objTimeOut.Timeout Then
                    m_LastError = ERROR_FTP_USER_TIMEOUT
                    Exit Do
                End If
                '
                If wscData.State = sckClosing Or _
                    wscData.State = sckClosed Then
                    'clear winsock buffer
                    RaiseEvent StateChanged(FTP_TRANSFER_COMLETED)
                    Exit Do
                End If
            Loop
            m_objTimeOut.StopTimer
            UploadFile = True
        End If
    End If
    
    m_bBusy = False
    
End Function
Private Function ProcessSTORCommand(strLocalFileName As String, strRemoteFileName As String, lStartPoint As Long) As Boolean
    
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessSTORCommand_Err_Handler
    
    m_strDataBuffer = ""
    wscControl.SendData "STOR " & strRemoteFileName & vbCrLf
    Debug.Print "STOR " & strRemoteFileName
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            If GetResponseCode(m_strWinsockBuffer) = 150 Or _
                GetResponseCode(m_strWinsockBuffer) = 125 Then
                m_strWinsockBuffer = ""
                RaiseEvent StateChanged(FTP_TRANSFER_STARTING)
                m_strLocalFilePath = strLocalFileName
                Call UploadData(lStartPoint)
            Else
                strData = m_strWinsockBuffer
                m_strWinsockBuffer = ""
                Exit Do
            End If
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Or _
        GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessSTORCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessSTORCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessSTORCommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Private Sub wscData_SendComplete()
    
    If m_bUploadFile Then
        Call UploadData(0)
    End If
    
    m_objTimeOut.Reset
    
End Sub
Private Sub wscData_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    m_lUploadedBytes = m_lUploadedBytes + bytesSent
    
    RaiseEvent UploadProgress(m_lUploadedBytes)
End Sub
Private Sub UploadData(lStartPoint As Long)
'--------------------------------------------------------------------------------
'Author      :Oleg Gdalevich
'Date/Time   :14.09.99
'Purpose     :Opens file, reads data from the file and
'             sends the data to remote computer by 4kb (CHANK_SIZE) chanks.
'Description :If file size is more than CHANK_SIZE the procedure called one or
'             multiple times from wscFtpData_SendComplete event procedure.
'--------------------------------------------------------------------------------
    
    Const CHANK_SIZE As Integer = 4096
    
    Static bFileIsOpen  As Boolean  'flag variable
    Static lChanksCount As Long     'quantity of chanks to send
    Static lCounter     As Long     'sent chanks counter
    Static intRemainder As Integer  '
    Dim strData         As String   'data buffer to send
    
    On Error GoTo UploadData_Err_Handler
    'if bFileIsOpen = True, the procedure was called before
    If m_bFileIsOpened Then
        'if we have to send next chank
        If lCounter < lChanksCount And lCounter > 0 Then
            'prepare the buffer
            strData = Space(CHANK_SIZE)
            'increament counter
            lCounter = lCounter + 1
            'read data from file
            Get m_intLocalFileID, , strData
            'send data
            wscData.SendData strData
        Else
            'all the data is sent
            If lCounter = 0 Then
                '
                'close data connection to inform ftp server
                'that transfer is comlteted
                '
                wscData.Close
                '
                'close local file
                '
                Close #m_intLocalFileID
                '
                RaiseEvent StateChanged(FTP_TRANSFER_COMLETED)
                '
                'reset values of all static and module
                'level variables
                '
                m_lUploadedBytes = 0:       lChanksCount = 0: intRemainder = 0
                m_bFileIsOpened = False:        m_bUploadFile = False
                '
            Else
                'all the chanks are sent
                'now we have to send the remainder
                '
                'prepare the buffer
                strData = Space(intRemainder)
                'reset the counter
                lCounter = 0
                'read data from file
                Get m_intLocalFileID, , strData
                'send data
                m_objTimeOut.StartTimer
                Do
                    DoEvents
                    '
                    If m_objTimeOut.Timeout Then
                        m_LastError = ERROR_FTP_USER_TIMEOUT
                        Exit Do
                    End If
                    '
                    If wscData.State = sckConnected Then
                        wscData.SendData strData
                        Exit Do
                    End If
                Loop
                m_objTimeOut.StopTimer
            End If
        End If
    Else
        '
        'if we are here, the procedure called at first time
        '
        m_bFileIsOpened = True  'turn on flag variable
        '
        m_intLocalFileID = FreeFile
        '
        Open m_strLocalFilePath For Binary As m_intLocalFileID
        '
        If lStartPoint > 0 Then
            Seek m_intLocalFileID, lStartPoint + 1
            m_lUploadedBytes = lStartPoint
            'get quantity of chancks to send
            lChanksCount = CLng((FileLen(m_strLocalFilePath) - lStartPoint)  CHANK_SIZE)
            'get remainder in bytes
            intRemainder = (FileLen(m_strLocalFilePath) - lStartPoint) Mod CHANK_SIZE
        Else
            '
            'get quantity of chancks to send
            lChanksCount = CLng(FileLen(m_strLocalFilePath)  CHANK_SIZE)
            '
            'get remainder in bytes
            intRemainder = FileLen(m_strLocalFilePath) Mod CHANK_SIZE
        End If
        
        If lChanksCount = 0 Then
            'if amount of data is less then 4Kb
            'prepare buffer to read data from a file
            strData = Space(intRemainder)
        Else
            '
            'prepare buffer to read data from a file
            strData = Space(CHANK_SIZE)
            'increament counter of sent chanks
            lCounter = 1
        End If
        'open file to read data
        'Open m_strLocalFilePath For Binary As #intFile
        'read data to buffer strData
        Get m_intLocalFileID, , strData
        'send data
                Do
                    DoEvents
                    If wscData.State = sckConnected Then
                        wscData.SendData strData
                        Exit Do
                    End If
                Loop
        '
        'If lCounter>0, file size if equal or less then chank size
        'and we have to send more data. At the next time this sub will
        'be called from wscData_SendComplete event procedure to send
        'next chank or remainder.
        '
    End If
    
    Exit Sub
    
Exit_Label:
    Exit Sub
UploadData_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.UploadData", Err.Description
    End If
    Close #intFile
    GoTo Exit_Label
    
End Sub
Private Function ShowTimeOut() As Boolean
    Dim intRetVal As Integer
    
    intRetVal = MsgBox("A time-out occurred while communicating with the server." & _
                "The server took too long to respond." & vbCrLf & vbCrLf & _
                "Would you like to wait for server response?", vbYesNo + vbQuestion, _
                "Time out")
    
    If intRetVal = vbYes Then
        m_objTimeOut.Reset
        m_objTimeOut.StartTimer
        ShowTimeOut = True
    End If
    
End Function
Public Property Let Timeout(NewValue As Integer)
    m_intTimeout = NewValue
    m_objTimeOut.TimeoutValue = NewValue
End Property
Public Property Get Timeout() As Integer
    Timeout = m_intTimeout
End Property
Public Property Get Busy() As Boolean
    Busy = m_bBusy
End Property
Private Function ProcessWinsockError(intError As ErrorConstants, strDesc As String) As Boolean
    m_strLastErrorDesc = strDesc
    
    Select Case intError
        Case sckAddressInUse
            m_LastError = ERROR_FTP_WINSOCK_AddressInUse
        Case sckAddressNotAvailable
            m_LastError = ERROR_FTP_WINSOCK_AddressNotAvailable
        Case sckAlreadyComplete
            m_LastError = ERROR_FTP_WINSOCK_AlreadyComplete
        Case sckAlreadyConnected
            m_LastError = ERROR_FTP_WINSOCK_AlreadyConnected
        Case sckBadState
            m_LastError = ERROR_FTP_WINSOCK_BadState
        Case sckConnectAborted
            m_LastError = ERROR_FTP_WINSOCK_ConnectAborted
        Case sckConnectionRefused
            m_LastError = ERROR_FTP_WINSOCK_ConnectionRefused
        Case sckConnectionReset
            m_LastError = ERROR_FTP_WINSOCK_ConnectionReset
        Case sckGetNotSupported
            m_LastError = ERROR_FTP_WINSOCK_GetNotSupported
        Case sckHostNotFound
            m_LastError = ERROR_FTP_WINSOCK_HostNotFound
        Case sckHostNotFoundTryAgain
            m_LastError = ERROR_FTP_WINSOCK_HostNotFoundTryAgain
        Case sckInProgress
            m_LastError = ERROR_FTP_WINSOCK_InProgress
        Case sckInvalidArg
            m_LastError = ERROR_FTP_WINSOCK_InvalidArg
        Case sckInvalidArgument
            m_LastError = ERROR_FTP_WINSOCK_InvalidArgument
        Case sckInvalidOp
            m_LastError = ERROR_FTP_WINSOCK_InvalidOp
        Case sckInvalidPropertyValue
            m_LastError = ERROR_FTP_WINSOCK_InvalidPropertyValue
        Case sckMsgTooBig
            m_LastError = ERROR_FTP_WINSOCK_MsgTooBig
        Case sckNetReset
            m_LastError = ERROR_FTP_WINSOCK_NetReset
        Case sckNetworkSubsystemFailed
            m_LastError = ERROR_FTP_WINSOCK_NetworkSubsystemFailed
        Case sckNetworkUnreachable
            m_LastError = ERROR_FTP_WINSOCK_NetworkUnreachable
        Case sckNoBufferSpace
            m_LastError = ERROR_FTP_WINSOCK_NoBufferSpace
        Case sckNoData
            m_LastError = ERROR_FTP_WINSOCK_NoData
        Case sckNonRecoverableError
            m_LastError = ERROR_FTP_WINSOCK_NonRecoverableError
        Case sckNotConnected
            m_LastError = ERROR_FTP_WINSOCK_NotConnected
        Case sckNotInitialized
            m_LastError = ERROR_FTP_WINSOCK_NotInitialized
        Case sckNotSocket
            m_LastError = ERROR_FTP_WINSOCK_NotSocket
        Case sckOpCanceled
            m_LastError = ERROR_FTP_WINSOCK_OpCanceled
        Case sckOutOfMemory
            m_LastError = ERROR_FTP_WINSOCK_OutOfMemory
        Case sckOutOfRange
            m_LastError = ERROR_FTP_WINSOCK_OutOfRange
        Case sckPortNotSupported
            m_LastError = ERROR_FTP_WINSOCK_PortNotSupported
        Case sckSetNotSupported
            m_LastError = ERROR_FTP_WINSOCK_SetNotSupported
        Case sckSocketShutdown
            m_LastError = ERROR_FTP_WINSOCK_SocketShutdown
        Case sckSuccess
            m_LastError = ERROR_FTP_WINSOCK_Success
        Case sckTimedout
            m_LastError = ERROR_FTP_WINSOCK_Timedout
        Case sckUnsupported
            m_LastError = ERROR_FTP_WINSOCK_Unsupported
        Case sckWouldBlock
            m_LastError = ERROR_FTP_WINSOCK_WouldBlock
        Case sckWrongProtocol
            m_LastError = ERROR_FTP_WINSOCK_WrongProtocol
    Case Else
        ProcessWinsockError = False
        Exit Function
    End Select
    
    ProcessWinsockError = True
    
End Function
Private Function ProcessFtpResponse(intCode As FTP_RESPONSE_CODES) As Boolean
    Select Case intCode
        Case FTP_RESPONSE_RESTATRT_MARKER_REPLY
        Case FTP_RESPONSE_SERVICE_READY_IN_MINUTES
        Case FTP_RESPONSE_DATA_CONNECTION_ALREADY_OPEN
        Case FTP_RESPONSE_FILE_STATUS_OK
        Case FTP_RESPONSE_COMMAND_OK
        Case FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_SUPERFLUOUS_AT_THIS_SITE
        Case FTP_RESPONSE_SYSTEM_STATUS_OR_SYSTEM_HELP_REPLY
        Case FTP_RESPONSE_DIRECTORY_STATUS
        Case FTP_RESPONSE_FILE_STATUS
        Case FTP_RESPONSE_HELP_MESSAGE
        Case FTP_RESPONSE_NAME_SYSTEM_TYPE
        Case FTP_RESPONSE_SERVICE_READY_FOR_NEW_USER
        Case FTP_RESPONSE_SERVICE_CLOSING_CONTROL_CONNECTION
        Case FTP_RESPONSE_DATA_CONNECTION_OPEN
        Case FTP_RESPONSE_CLOSING_DATA_CONNECTION
        Case FTP_RESPONSE_ENTERING_PASSIVE_MODE
        Case FTP_RESPONSE_USER_LOGGED_IN
        Case FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED
        Case FTP_RESPONSE_PATHNAME_CREATED
        Case FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD
            m_LastError = ERROR_FTP_PROTOCOL_USER_NAME_OK_NEED_PASSWORD
        Case FTP_RESPONSE_NEED_ACCOUNT_FOR_LOGIN
            m_LastError = ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_LOGIN
        Case FTP_RESPONSE_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO
        Case FTP_RESPONSE_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
            m_LastError = ERROR_FTP_PROTOCOL_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
            m_strLastErrorDesc = "Service not available, closing control connection."
        Case FTP_RESPONSE_CANNOT_OPEN_DATA_CONNECTION
            m_strLastErrorDesc = "Can't open data connection."
            m_LastError = ERROR_FTP_PROTOCOL_CANNOT_OPEN_DATA_CONNECTION
        Case FTP_RESPONSE_CONNECTION_CLOSED_TRANSFER_ABORTED
            m_strLastErrorDesc = "Connection closed; transfer aborted."
            m_LastError = ERROR_FTP_PROTOCOL_CONNECTION_CLOSED_TRANSFER_ABORTED
        Case FTP_RESPONSE_REQUESTED_FILE_ACTION_NOT_TAKEN
            m_strLastErrorDesc = "Requested file action not taken."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN
        Case FTP_RESPONSE_REQUESTED_ACTION_ABORTED
            m_strLastErrorDesc = "Requested action aborted: local error in processing."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED
        Case FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN
            m_strLastErrorDesc = "Requested action not taken. Insufficient storage space in system."
        Case FTP_RESPONSE_SYNTAX_ERROR_COMMAND_UNRECOGNIZED
            m_strLastErrorDesc = "Syntax error, command unrecognized."
            m_LastError = ERROR_FTP_PROTOCOL_SYNTAX_ERROR_COMMAND_UNRECOGNIZED
        Case FTP_RESPONSE_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS
            m_strLastErrorDesc = "Syntax error in parameters or arguments."
            m_LastError = ERROR_FTP_PROTOCOL_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS
        Case FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED
            m_strLastErrorDesc = "Command not implemented."
            m_LastError = ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED
        Case FTP_RESPONSE_BAD_SEQUENCE_OF_COMMANDS
            m_strLastErrorDesc = "Bad sequence of commands."
            m_LastError = ERROR_FTP_PROTOCOL_BAD_SEQUENCE_OF_COMMANDS
        Case FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER
            m_strLastErrorDesc = "Command not implemented for that parameter."
            m_LastError = ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER
        Case FTP_RESPONSE_NOT_LOGGED_IN
            m_strLastErrorDesc = "Not logged in."
            m_LastError = ERROR_FTP_PROTOCOL_NOT_LOGGED_IN
        Case FTP_RESPONSE_NEED_ACCOUNT_FOR_STORING_FILES
            m_strLastErrorDesc = "Need account for storing files."
            m_LastError = ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_STORING_FILES
        Case FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE
            m_strLastErrorDesc = "Requested action not taken. File unavailable (e.g., file not found, no access)."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE
        Case FTP_RESPONSE_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN
            m_strLastErrorDesc = "Requested action aborted: page type unknown."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN
        Case FTP_RESPONSE_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION
            m_strLastErrorDesc = "Requested file action aborted. Exceeded storage allocation (for current directory or dataset)."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION
        Case FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED
            m_strLastErrorDesc = "Requested action not taken. File name not allowed."
            m_LastError = ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED
        Case Else
            ProcessFtpResponse = False
            Exit Function
    End Select
    
    ProcessFtpResponse = True
    
End Function
Public Function GetCurrentDirectory() As String
    m_bBusy = True
    If ProcessPWDCommand Then
        GetCurrentDirectory = m_strCurrentDirectory
    End If
    m_bBusy = False
    
End Function
Private Function ProcessQUITCommand() As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessQUITCommand_Err_Handler
    
    wscControl.SendData "QUIT" & vbCrLf
    Debug.Print "QUIT"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_SERVICE_CLOSING_CONTROL_CONNECTION Then
        ProcessQUITCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessQUITCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessQUITCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessABORCommand() As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessABORCommand_Err_Handler
    
    wscControl.SendData "ABOR" & vbCrLf
    Debug.Print "ABOR"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = "226" & vbCrLf
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = 426 Then
        ProcessABORCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessABORCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessABORCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Public Function CancelTransfer() As Boolean
    m_bBusy = True
    If ProcessABORCommand Then
        CancelTransfer = True
    End If
    If m_bTransferInProgress Or m_bUploadFile Then
        Close m_intLocalFileID
        m_strDataBuffer = ""
        m_lDownloadedBytes = 0
        m_lUploadedBytes = 0
        m_bTransferInProgress = False
        m_bUploadFile = False
    End If
    m_bFileIsOpened = False
    m_objTimeOut.StopTimer
'    wscData.Close
    m_bBusy = False
    
End Function
Public Function SetParentAsCurrentDirectory() As Boolean
    m_bBusy = True
    SetParentAsCurrentDirectory = ProcessCDUPCommand
    m_bBusy = False
    
End Function
Private Function ProcessCDUPCommand() As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessCDUPCommand_Err_Handler
    
    wscControl.SendData "CDUP" & vbCrLf
    Debug.Print "CDUP"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessCDUPCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessCDUPCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessCDUPCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function
Private Function ProcessCWDCommand(strNewDir As String) As Boolean
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessCWDCommand_Err_Handler
        
    wscControl.SendData "CWD " & strNewDir & vbCrLf
    Debug.Print "CWD " & strNewDir
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            strData = m_strWinsockBuffer
            m_strWinsockBuffer = ""
            Exit Do
        End If
    Loop
    m_objTimeOut.StopTimer
    If GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        ProcessCWDCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function
ProcessCWDCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessCWDCommand", Err.Description
    End If
    GoTo Exit_Label
End Function
Public Function GetFtpErrorDescription() As String
    GetFtpErrorDescription = m_strLastErrorDesc
End Function
Public Function CloseConnection() As Boolean
    m_bBusy = True
    If m_bTransferInProgress Or m_bUploadFile Then
        m_LastError = ERROR_FTP_USER_TRANSFER_IN_PROGRESS
        m_strLastErrorDesc = "Can't close control connection. Transfer in progress."
    Else
        CloseConnection = ProcessQUITCommand
        wscData.Close
        wscControl.Close
    End If
    m_bBusy = False
    
End Function

						