VB写的FTP客户端程序

【核心代码】

'********************************************************************************
'CFtpConnection类
'********************************************************************************
'   在该类里面使用了以下几个类和模块
'   CFtpFile    类
'   CFtpFiles   类
'   CTimeout    类
'   MFtpSupport 模块
'
'   同时在该类中使用到了winsock对象，因此在工程的REFERENCES中加入对该对象的引用

'********************************************************************************
'winsock对象的声明
'********************************************************************************
'声明进行控制连接的winsock对象
Private WithEvents wscControl As MSWinsockLib.Winsock
'声明进行数据连接的winsock对象
Private WithEvents wscData As MSWinsockLib.Winsock
'********************************************************************************
'定义类模块的内部属性变量
'********************************************************************************
Private m_strUserName           As String           '定义连接ftp服务器用户名
Private m_strPassword           As String           '定义连接ftp服务器密码
Private m_varFtpServer          As Variant          '定义连接ftp服务器地址
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 '定义传输模式
'********************************************************************************
'公共枚举变量
'********************************************************************************
'连接ftp服务器时的各种状态
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
'ftp服务器各种返回的响应码
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
'ftp传输模式
Public Enum FtpTransferModes
    FTP_ASCII_MODE 'ASCII模式
    FTP_IMAGE_MODE '二进制模式
End Enum
'********************************************************************************
'类错误
'********************************************************************************
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

'********************************************************************************
'定义类事件
'********************************************************************************
Public Event StateChanged(State As FTP_CONNECTION_STATES)
Public Event DownloadProgress(lBytes As Long)
Public Event UploadProgress(lBytes As Long)
Public Event ReplyMessage(ByVal sMessage As String)
'********************************************************************************
'类模块内部的变量和常数
'********************************************************************************
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
'********************************************************************************
'该函数的功能是向服务器发送LIST命令
'list的功能是获得指定目录中的字目录、文件列表或者是指定文件的信息
'modified by wxp
'Date   2000-11
'********************************************************************************

On Error GoTo ProcessLISTCommand_Err_Handler

    Dim strResponse As String
    Dim strData     As String

    wscControl.SendData "LIST" & vbCrLf
    Debug.Print "LIST"
    RaiseEvent ReplyMessage("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
                '忽略150返回码
                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
'********************************************************************************
'该函数的功能是获得当前目录下面的所有目录和文件
'modified by wxp
'Date  2000-10
'********************************************************************************

Dim bDataConnectionEstablished As Boolean

'On Error GoTo EnumFiles_Err_Handler

    m_bBusy = True

    If m_bPassiveMode Then
        '如果是被动模式
        bDataConnectionEstablished = ProcessPASVCommand
    Else
        '否则发送port命令
        bDataConnectionEstablished = ProcessPORTCommand
    End If
    
    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
            '产生错误，不能建立连接
        End If
    Else
        '产生错误，不能建立连接
    End If

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
'********************************************************************************
'该函数的功能是连接ftp服务器
'modified by wxp
'Date   2000-11
'********************************************************************************

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
                    '如果是220，表示服务已经为新用户准备好
                        Select Case ProcessUSERCommand
                            Case FTP_RESPONSE_USER_LOGGED_IN
                             '如果为230，表示登录成功
                               Connect = True
                            Case FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD
                            '如果是需要密码验证，则下一步进行密码验证
                                If ProcessPASSCommand = FTP_RESPONSE_USER_LOGGED_IN Then
                                    Connect = True
                                End If
                        End Select
                        If Connect Then
                        '如果登陆成功，则获得当前工作目录
                            Call ProcessPWDCommand
                        End If
                    Case FTP_RESPONSE_SERVICE_READY_IN_MINUTES
                    '如果是120，表示服务器将在nnn分钟后准备好
                        m_LastError = ERROR_FTP_PROTOCOL_SERVICE_READY_IN_MINUTES
                    Case FTP_RESPONSE_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
                    '如果是421表示服务不可用，关闭连接
                        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
    '产生错误
    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
            '产生错误，退出该函数
            'Exit Function
        End If
    End If
    '发送用户名
    wscControl.SendData "USER " & m_strUserName & vbCrLf
    Debug.Print "USER " & m_strUserName
    RaiseEvent ReplyMessage("USER " & m_strUserName & vbCrLf)
    
    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)
        '如果是230，表示用户登录成功，继续
        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
    RaiseEvent ReplyMessage("PASS " & "**********" & vbCrLf)
    
    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"
    RaiseEvent ReplyMessage("PWD" & vbCrLf)
    
    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
    '如果响应码为257，表示已经创建"PATHNAME"
        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
            '未知的响应格式
        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
'该事件为winsock对象的事件，用来获得从服务器端的数据,该控件主要是发送命令和接收返回码
Private Sub wscControl_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    Dim strData As String
    
    wscControl.GetData strData
    m_strWinsockBuffer = m_strWinsockBuffer & strData
    m_strLastServerResponse = strData
    '每次接收到数据的时候，计时器标记清0
    m_objTimeOut.Reset
    
    '返回码为426表示连接关闭,传输终止
    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)
    RaiseEvent ReplyMessage(Left(strData, Len(strData) - 2) & vbCrLf)
    
End Sub

Private Function ProcessPORTCommand() As Boolean
'该函数的功能是发送port命令，为数据连接指定一个ip地址和本地地址
    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
    '向服务器发送port命令
    Debug.Print Left(strSend, Len(strSend) - 2)
    RaiseEvent ReplyMessage(Left(strSend, Len(strSend) - 2) & vbCrLf)
    
    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)
'如果采用port方式接受或者发送数据，该事件接受对方的连接
    If wscData.State <> sckClosed Then wscData.Close
    
    wscData.Accept (requestID)
    
End Sub

Private Sub wscData_DataArrival(ByVal bytesTotal As Long)
'wscData的DataArrival事件，同时得到服务器传来的数据
    '该变量用来获得字符型的数据
    Dim strData As String
    '该变量用来获得从服务器上传来的二进制数据
    Dim temparray() As Byte
    
    On Error Resume Next
    
    '如果传来的数据数为0，则退出该事件
    If bytesTotal = 0 Then Exit Sub
    
    '如果正在进行文件传输，主要是下载文件
    If m_bTransferInProgress Then
        '定义数组的大小为实际从服务器传来数据量的大小
        ReDim temparray(bytesTotal)
        wscData.GetData temparray(), vbByte
    Else
    '否则将数据存在字符型变量中
        wscData.GetData strData
    End If
    
    '如果是文件传输而且不是上载
    If m_bTransferInProgress And Not m_bUploadFile Then
        '如果文件没有打开，则需要打开文件
        If Not m_bFileIsOpened Then
            '获得一个自由的文件号
            m_intLocalFileID = FreeFile
            '以二进制文件打开文件
            Open m_strLocalFilePath For Binary As m_intLocalFileID
            
            '标志文件已经打开
            m_bFileIsOpened = True
            '初始化下载字节数为0
            m_lDownloadedBytes = 0
        End If
        
        '将数据写到文件中
        Put m_intLocalFileID, , temparray
        m_lDownloadedBytes = m_lDownloadedBytes bytesTotal

         RaiseEvent DownloadProgress(m_lDownloadedBytes)
 
    Else
        '如果不是传输文件，则把信息加入缓冲区m_strDataBuffer
        m_strDataBuffer = m_strDataBuffer & strData
    End If
    '计时器清0
    m_objTimeOut.Reset
    Exit Sub
    
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
    '传来的数据项之间都是用回车换行符隔开的，所以通过split函数分出来
    vFiles = Split(strListing, vbCrLf)
    '
    For Each vFile In vFiles
        Set oFtpFile = New CFtpFile
        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
                        .Permissions = vComponents(0)
                        .Owner = vComponents(2)
                        .Group = vComponents(3)
                        .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
                        Debug.Print "vComponents(2): " & vComponents(2), "vComponents(3): " & vComponents(3)
                        .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"
    RaiseEvent ReplyMessage("PASV" & vbCrLf)
    
    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
'该函数是建立被动模式数据连接
    '
    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
            RaiseEvent ReplyMessage("Connecting to: " & strIP & ":" & lPort & vbCrLf)
            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   'Left(strLocalFileName, InStrRev(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 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
'该函数的命令是向服务器发送retr命令，让服务器给客户传送一份在路径名中指定的文件的副本
    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
    RaiseEvent ReplyMessage("RETR " & strFileName & vbCrLf)
    m_objTimeOut.StartTimer
    AllBytes = 0
    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
                
                '如果文件没有打开,则打开文件
                If Not m_bFileIsOpened Then
                    m_intLocalFileID = FreeFile
                    If Not m_bFileIsOpened Then '如果已经打开，再打开？？？
                        Open m_strLocalFilePath For Binary As m_intLocalFileID
                    End If
                    If lStartPoint > 0 Then
                        Seek m_intLocalFileID, lStartPoint 1
                    End If
                    m_bFileIsOpened = True
                    m_lDownloadedBytes = 0
                End If
                
                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)
        ProcessRETRCommand = False
    End If
    'modify by xmxoxo 2007.9.25 及时关闭
    If m_bFileIsOpened Then
        Close #m_intLocalFileID
    End If
    
    Debug.Print GetResponseCode(strData)
Exit_Label:
    Exit Function

ProcessRETRCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Clear
        '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
'该函数的的功能是向服务器发送rest命令，表示将从lstartpoint点开始传输文件
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRESTCommand_Err_Handler
    
    wscControl.SendData "REST " & lStartPoint & vbCrLf
    Debug.Print "REST " & lStartPoint
    RaiseEvent ReplyMessage("REST " & lStartPoint & vbCrLf)
    
    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
'该函数的功能是向服务器发送type命令，表示传输模式
    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")
    RaiseEvent ReplyMessage("TYPE " & IIf(vType = FTP_ASCII_MODE, "A", "I") & vbCrLf)
    
    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
    RaiseEvent ReplyMessage("DELE " & strFileName & vbCrLf)
    
    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
    RaiseEvent ReplyMessage("MKD " & strDirName & vbCrLf)
    
    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
'该函数的功能是向服务器发送rmd命令，表示要删除一个目录
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRMDCommand_Err_Handler
    
    wscControl.SendData "RMD " & strDirName & vbCrLf
    Debug.Print "RMD " & strDirName
    RaiseEvent ReplyMessage("RMD " & strDirName & vbCrLf)
    
    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
'该函数的功能是向服务器发送rnfr命令，表示要重新命名一个文件名
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRNFRCommand_Err_Handler
    
    wscControl.SendData "RNFR " & strFileName & vbCrLf
    Debug.Print "RNFR " & strFileName
    RaiseEvent ReplyMessage("RNFR " & strFileName & vbCrLf)
    
    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
'该函数的功能是向服务器发送rnto命令
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessRNTOCommand_Err_Handler
    
    wscControl.SendData "RNTO " & strFileName & vbCrLf
    Debug.Print "RNTO " & strFileName
    RaiseEvent ReplyMessage("RNTO " & strFileName & vbCrLf)
    
    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
'该函数的功能是向服务器发送stor命令，让服务器准备接收一个来自数据连接的文件
    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
    RaiseEvent ReplyMessage("STOR " & strRemoteFileName & vbCrLf)
    
    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)
'--------------------------------------------------------------------------------
'该函数的功能是是打开一个文件，然后把数据上传到服务器，每次传送4k字节
'modified by wxp
'date 2000-11
'说明 :如果一次传送多于4k的字节，则有可能多次产生wscFtpData_SendComplete事件
'--------------------------------------------------------------------------------
    
    Const CHANK_SIZE As Integer = 4096
    
    Static bFileIsOpen  As Boolean  '标记变量
    Static lChanksCount As Long     '总共要传送的次数
    Static lCounter     As Long     '已经传送的次数
    Static intRemainder As Integer  '
    Dim strData()         As Byte   '用来存放被发送的数据
    
    On Error GoTo UploadData_Err_Handler
    '如果 bFileIsOpen = True,则表示文件已经被打开了
    If m_bFileIsOpened Then
        '上传下一个数据包
        If lCounter < lChanksCount And lCounter > 0 Then
            '首先开辟一个4k的缓存
            ReDim strData(CHANK_SIZE)
            '计数器加一
            lCounter = lCounter 1
            '从文件中读去数据到strdata中
            Get m_intLocalFileID, , strData()
            '发送数据
            wscData.SendData strData()
        Else
            '所有的数据已经上载
            If lCounter = 0 Then
                '
                '关闭数据连接
                '连接已经完成
                '
                wscData.Close
                '
                '关闭本地文件
                '
                Close #m_intLocalFileID
                '
                RaiseEvent StateChanged(FTP_TRANSFER_COMLETED)
                '
                '初始化一些数据
                
                '
                m_lUploadedBytes = 0:       lChanksCount = 0: intRemainder = 0
                m_bFileIsOpened = False:        m_bUploadFile = False
                '
            Else
                '现在发送剩余的数据
                'now we have to send the remainder
                ReDim strData(intRemainder)
                '将计数器清0，下面是最后一批数据了
                lCounter = 0
                '从文件中读取数据
                Get m_intLocalFileID, , strData()
                '发送数据
                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
        '
        '以下是第一次发送数据，需要打开文件
        '
        m_bFileIsOpened = True  '做一个文件打开的标志
        '
        m_intLocalFileID = FreeFile
        '
        Open m_strLocalFilePath For Binary As m_intLocalFileID
        '如果开始上传的起始点大于0，则表示是发送剩余的数据，类似与断点续传
        If lStartPoint > 0 Then
            Seek m_intLocalFileID, lStartPoint 1
            m_lUploadedBytes = lStartPoint
            '获得剩余文件大小，并计算需要分成几个数据包发送
            lChanksCount = CLng((FileLen(m_strLocalFilePath) - lStartPoint) \ CHANK_SIZE)
            '获得不完整数据包即最后一个数据包的大小
            intRemainder = (FileLen(m_strLocalFilePath) - lStartPoint) Mod CHANK_SIZE
        Else
            '
            '如果是上传整个文件,则计算完整的数据包的个数
            lChanksCount = CLng(FileLen(m_strLocalFilePath) \ CHANK_SIZE)
            '
            '获得剩余字节
            intRemainder = FileLen(m_strLocalFilePath) Mod CHANK_SIZE
        End If

        
        If lChanksCount = 0 Then
            '如果整个文件不足一个完整的数据包，即4k，则创建一个实际文件大小的缓存区
            
            ReDim strData(intRemainder)
        Else
            '
            '否则创建一个4k大小的内存空间
            ReDim strData(CHANK_SIZE)
            '将发送数据包的计数器设置为1
            lCounter = 1
        End If
        
        '从文件中读取数据
        Get m_intLocalFileID, , strData
        '发送数据
                Do
                    DoEvents
                    If wscData.State = sckConnected Then
                        wscData.SendData strData
                        Exit Do
                    End If
                Loop
        '
    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
'该函数的功能处理winsock通讯时的错误
    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
'该函数的功能是向服务器发送quit命令，终止连接、注销用户
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessQUITCommand_Err_Handler
    
    wscControl.SendData "QUIT" & vbCrLf
    Debug.Print "QUIT"
    RaiseEvent ReplyMessage("QUIT" & vbCrLf)
    
    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
'该函数的功能是终止上一次ftp服务器命令及相关数据传输
    Dim strResponse As String
    Dim strData     As String
    
    On Error GoTo ProcessABORCommand_Err_Handler
    
    wscControl.SendData "ABOR" & vbCrLf
    Debug.Print "ABOR"
    RaiseEvent ReplyMessage("ABOR" & vbCrLf)
    
    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"
    RaiseEvent ReplyMessage("CDUP" & vbCrLf)
    
    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
    RaiseEvent ReplyMessage("CWD " & strNewDir & vbCrLf)
    
    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