cftpconnection.cls

用vb开发的ftp客服端

        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_REQUEST