cftpconnection.cls

用vb开发的ftp客服端

    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