cftpconnection.cls

用vb开发的ftp客服端

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CFtpConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'********************************************************************************
'CFtpConnection class
'Copyright 2000 by Oleg Gdalevich
'Visual Basic Internet Programming website (http://www.vbip.com)
'********************************************************************************
'To use this class module you need:
'   CFtpFile    class module
'   CFtpFiles   calss module
'   CTimeout    class module
'   MFtpSupport module
'
'   Also you need to set up the refernce to Winsock ActiveX Control
'   via REFERENCES dialog window. To do this, open Project References
'   dialog, click Browse button and select Mswinsck.ocx
'
'********************************************************************************
'Declarations of winsock objects.
'********************************************************************************
'Winsock Control for control connection
Private WithEvents wscControl As MSWinsockLib.Winsock
Attribute wscControl.VB_VarHelpID = -1
'Winsock Control for data connection
Private WithEvents wscData As MSWinsockLib.Winsock
Attribute wscData.VB_VarHelpID = -1
'********************************************************************************
'Local variables to hold values of the class properies
'********************************************************************************
Private m_strUserName           As String
Private m_strPassword           As String
Private m_varFtpServer          As Variant
Private m_strCurrentDirectory   As String
Private m_bPassiveMode          As Boolean
Private m_bBusy                 As Boolean
Private m_intTimeout            As Integer
Private m_TransferMode          As FtpTransferModes
'********************************************************************************
'Public Enums
'********************************************************************************
'various states of ftp connection
Public Enum FTP_CONNECTION_STATES
    FTP_CONNECTION_RESOLVING_HOST
    FTP_CONNECTION_HOST_RESOLVED
    FTP_CONNECTION_CONNECTED
    FTP_CONNECTION_AUTHENTICATION
    FTP_USER_LOGGED
    FTP_ESTABLISHING_DATA_CONNECTION
    FTP_DATA_CONNECTION_ESTABLISHED
    FTP_RETRIEVING_DIRECTORY_INFO
    FTP_DIRECTORY_INFO_COMPLETED
    FTP_TRANSFER_STARTING
    FTP_TRANSFER_COMLETED
End Enum
'all possible reply codes that can be sent by ftp server
Private Enum FTP_RESPONSE_CODES
    FTP_RESPONSE_RESTATRT_MARKER_REPLY = 110
    FTP_RESPONSE_SERVICE_READY_IN_MINUTES = 120
    FTP_RESPONSE_DATA_CONNECTION_ALREADY_OPEN = 125
    FTP_RESPONSE_FILE_STATUS_OK = 150
    FTP_RESPONSE_COMMAND_OK = 200
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_SUPERFLUOUS_AT_THIS_SITE = 202 'superfluous at this site
    FTP_RESPONSE_SYSTEM_STATUS_OR_SYSTEM_HELP_REPLY = 211
    FTP_RESPONSE_DIRECTORY_STATUS = 212
    FTP_RESPONSE_FILE_STATUS = 213
    FTP_RESPONSE_HELP_MESSAGE = 214
    FTP_RESPONSE_NAME_SYSTEM_TYPE = 215
    FTP_RESPONSE_SERVICE_READY_FOR_NEW_USER = 220
    FTP_RESPONSE_SERVICE_CLOSING_CONTROL_CONNECTION = 221
    FTP_RESPONSE_DATA_CONNECTION_OPEN = 225
    FTP_RESPONSE_CLOSING_DATA_CONNECTION = 226
    FTP_RESPONSE_ENTERING_PASSIVE_MODE = 227
    FTP_RESPONSE_USER_LOGGED_IN = 230
    FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED = 250
    FTP_RESPONSE_PATHNAME_CREATED = 257
    FTP_RESPONSE_USER_NAME_OK_NEED_PASSWORD = 331
    FTP_RESPONSE_NEED_ACCOUNT_FOR_LOGIN = 332
    FTP_RESPONSE_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO = 350
    FTP_RESPONSE_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION = 421
    FTP_RESPONSE_CANNOT_OPEN_DATA_CONNECTION = 425
    FTP_RESPONSE_CONNECTION_CLOSED_TRANSFER_ABORTED = 426
    FTP_RESPONSE_REQUESTED_FILE_ACTION_NOT_TAKEN = 450
    FTP_RESPONSE_REQUESTED_ACTION_ABORTED = 451
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN = 452
    FTP_RESPONSE_SYNTAX_ERROR_COMMAND_UNRECOGNIZED = 500
    FTP_RESPONSE_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS = 501
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED = 502
    FTP_RESPONSE_BAD_SEQUENCE_OF_COMMANDS = 503
    FTP_RESPONSE_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER = 504
    FTP_RESPONSE_NOT_LOGGED_IN = 530
    FTP_RESPONSE_NEED_ACCOUNT_FOR_STORING_FILES = 532
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE = 550
    FTP_RESPONSE_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN = 551
    FTP_RESPONSE_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION = 552
    FTP_RESPONSE_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED = 553
End Enum
'transfer modes
Public Enum FtpTransferModes
    FTP_ASCII_MODE
    FTP_IMAGE_MODE
End Enum
'********************************************************************************
'Class errors
'********************************************************************************
Public Enum FtpErrors
    ERROR_FTP_WINSOCK_AddressInUse
    ERROR_FTP_WINSOCK_AddressNotAvailable
    ERROR_FTP_WINSOCK_AlreadyComplete
    ERROR_FTP_WINSOCK_AlreadyConnected
    ERROR_FTP_WINSOCK_BadState
    ERROR_FTP_WINSOCK_ConnectAborted
    ERROR_FTP_WINSOCK_ConnectionRefused
    ERROR_FTP_WINSOCK_ConnectionReset
    ERROR_FTP_WINSOCK_GetNotSupported
    ERROR_FTP_WINSOCK_HostNotFound
    ERROR_FTP_WINSOCK_HostNotFoundTryAgain
    ERROR_FTP_WINSOCK_InProgress
    ERROR_FTP_WINSOCK_InvalidArg
    ERROR_FTP_WINSOCK_InvalidArgument
    ERROR_FTP_WINSOCK_InvalidOp
    ERROR_FTP_WINSOCK_InvalidPropertyValue
    ERROR_FTP_WINSOCK_MsgTooBig
    ERROR_FTP_WINSOCK_NetReset
    ERROR_FTP_WINSOCK_NetworkSubsystemFailed
    ERROR_FTP_WINSOCK_NetworkUnreachable
    ERROR_FTP_WINSOCK_NoBufferSpace
    ERROR_FTP_WINSOCK_NoData
    ERROR_FTP_WINSOCK_NonRecoverableError
    ERROR_FTP_WINSOCK_NotConnected
    ERROR_FTP_WINSOCK_NotInitialized
    ERROR_FTP_WINSOCK_NotSocket
    ERROR_FTP_WINSOCK_OpCanceled
    ERROR_FTP_WINSOCK_OutOfMemory
    ERROR_FTP_WINSOCK_OutOfRange
    ERROR_FTP_WINSOCK_PortNotSupported
    ERROR_FTP_WINSOCK_SetNotSupported
    ERROR_FTP_WINSOCK_SocketShutdown
    ERROR_FTP_WINSOCK_Success
    ERROR_FTP_WINSOCK_Timedout
    ERROR_FTP_WINSOCK_Unsupported
    ERROR_FTP_WINSOCK_WouldBlock
    ERROR_FTP_WINSOCK_WrongProtocol
    ERROR_FTP_PROTOCOL_SERVICE_READY_IN_MINUTES
    ERROR_FTP_PROTOCOL_USER_NAME_OK_NEED_PASSWORD
    ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_LOGIN
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_PENDING_FURTHER_INFO
    ERROR_FTP_PROTOCOL_SERVICE_NOT_AVAILABLE_CLOSING_CONTROL_CONNECTION
    ERROR_FTP_PROTOCOL_CANNOT_OPEN_DATA_CONNECTION
    ERROR_FTP_PROTOCOL_CONNECTION_CLOSED_TRANSFER_ABORTED
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_NOT_TAKEN
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN
    ERROR_FTP_PROTOCOL_SYNTAX_ERROR_COMMAND_UNRECOGNIZED
    ERROR_FTP_PROTOCOL_SYNTAX_ERROR_IN_PARAMETERS_OR_ARGUMENTS
    ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED
    ERROR_FTP_PROTOCOL_BAD_SEQUENCE_OF_COMMANDS
    ERROR_FTP_PROTOCOL_COMMAND_NOT_IMPLEMENTED_FOR_THAT_PARAMETER
    ERROR_FTP_PROTOCOL_NOT_LOGGED_IN
    ERROR_FTP_PROTOCOL_NEED_ACCOUNT_FOR_STORING_FILES
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_UNAVAILABLE
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_ABORTED_PAGE_TYPE_UNKNOWN
    ERROR_FTP_PROTOCOL_REQUESTED_FILE_ACTION_ABORTED_EXCEEDED_STORAGE_ALLOCATION
    ERROR_FTP_PROTOCOL_REQUESTED_ACTION_NOT_TAKEN_FILE_NAME_NOT_ALLOWED
    ERROR_FTP_USER_TIMEOUT
    ERROR_FTP_USER_TRANSFER_IN_PROGRESS
End Enum

'********************************************************************************
'Class events
'********************************************************************************
Public Event StateChanged(State As FTP_CONNECTION_STATES)
Public Event DownloadProgress(lBytes As Long)
Public Event UploadProgress(lBytes As Long)
'********************************************************************************
'Service constants and variables used inside the class
'********************************************************************************
Const RESPONSE_CODE_LENGHT = 3
Private m_LastError             As FtpErrors
Private m_strLastErrorDesc      As String
Private m_strWinsockBuffer      As String
Private m_strDataBuffer         As String
Private m_strLocalFilePath      As String
Private m_intLocalFileID        As Integer
Private m_bTransferInProgress   As Boolean
Private m_lDownloadedBytes      As Long
Private m_bUploadFile           As Boolean
Private m_lUploadedBytes        As Long
Private m_strLastServerResponse As String
Private m_objTimeOut            As CTimeout
Private m_bFileIsOpened         As Boolean

'
Public Function FtpGetLastError() As FtpErrors
    FtpGetLastError = m_LastError
End Function

Public Function CurrentDirectory() As String
    CurrentDirectory = m_strCurrentDirectory
End Function

Public Function GetLastServerResponse() As String
    GetLastServerResponse = m_strLastServerResponse
End Function

Public Property Get TransferMode() As FtpTransferModes
    TransferMode = m_TransferMode
End Property

Public Property Let TransferMode(NewValue As FtpTransferModes)
    
    m_bBusy = True
    If Not (NewValue = m_TransferMode) Then
        If ProcessTYPECommand(NewValue) Then
            m_TransferMode = NewValue
        End If
    End If
    m_bBusy = False

End Property

Private Function ProcessLISTCommand() As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :07.01.00
'Purpose     :
'********************************************************************************

On Error GoTo ProcessLISTCommand_Err_Handler

    Dim strResponse As String
    Dim strData     As String

    wscControl.SendData "LIST" & vbCrLf
    Debug.Print "LIST"
    
    m_objTimeOut.StartTimer
    Do
        DoEvents
        '
        If m_objTimeOut.Timeout Then
            m_LastError = ERROR_FTP_USER_TIMEOUT
            Exit Do
        End If
        '
        If InStr(1, m_strWinsockBuffer, vbCrLf) > 0 Then
            If GetResponseCode(m_strWinsockBuffer) = 150 Or _
                GetResponseCode(m_strWinsockBuffer) = 125 Then
                'ignore 150 reply code
                m_strWinsockBuffer = Mid$(m_strWinsockBuffer, InStr(1, m_strWinsockBuffer, vbCrLf) + 2)
            Else
                strData = m_strWinsockBuffer
                m_strWinsockBuffer = ""
                Exit Do
            End If
        End If
    Loop
    m_objTimeOut.StopTimer
    
    If GetResponseCode(strData) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Or _
        GetResponseCode(strData) = FTP_RESPONSE_REQUESTED_FILE_ACTION_OK_COMPLETED Then
        
        ProcessLISTCommand = True
    Else
        ProcessFtpResponse GetResponseCode(strData)
    End If
    
Exit_Label:
    Exit Function

ProcessLISTCommand_Err_Handler:
    If Not ProcessWinsockError(Err.Number, Err.Description) Then
        Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.ProcessLISTCommand", Err.Description
    End If
    GoTo Exit_Label
    
End Function

Public Property Get PassiveMode() As Boolean
    PassiveMode = m_bPassiveMode
End Property

Public Property Let PassiveMode(NewValue As Boolean)
    m_bPassiveMode = NewValue
End Property

Public Function EnumFiles(oFiles As CFtpFiles) As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :07.01.00
'Purpose     :Enumerates the files and dirs in the current directory
'********************************************************************************

Dim bDataConnectionEstablished As Boolean

'On Error GoTo EnumFiles_Err_Handler

    m_bBusy = True

    If m_bPassiveMode Then
        'send PASV command
        bDataConnectionEstablished = ProcessPASVCommand
    Else
        'send PORT command
        bDataConnectionEstablished = ProcessPORTCommand
    End If 'm_bPassiveMode
    '
    If bDataConnectionEstablished Then
        RaiseEvent StateChanged(FTP_RETRIEVING_DIRECTORY_INFO)
        If ProcessLISTCommand Then
            m_objTimeOut.StartTimer
            Do
                DoEvents
                '
                If m_objTimeOut.Timeout Then
                    m_LastError = ERROR_FTP_USER_TIMEOUT
                    If GetResponseCode(Left(m_strLastServerResponse, 3)) = FTP_RESPONSE_CLOSING_DATA_CONNECTION Then
                        Set oFiles = GetFileList(m_strDataBuffer)
                        EnumFiles = True
                        RaiseEvent StateChanged(FTP_DIRECTORY_INFO_COMPLETED)
                        m_strDataBuffer = ""
                    End If
                    Exit Do
                End If
                '
                If wscData.State = sckClosing Or wscData.State = sckClosed Then
                    Set oFiles = Nothing
                    Set oFiles = GetFileList(m_strDataBuffer)
                    EnumFiles = True
                    RaiseEvent StateChanged(FTP_DIRECTORY_INFO_COMPLETED)
                    m_strDataBuffer = ""
                    Exit Do
                End If
            Loop
            m_objTimeOut.StopTimer
        Else
            'raise error - LIST command
        End If 'ProcessLISTCommand
    Else 'bDataConnectionEstablished
        'raise error - can't establish data connection
    End If 'bDataConnectionEstablished

Exit_Label:
    m_bBusy = False
    Exit Function

EnumFiles_Err_Handler:
    Err.Raise vbObjectError + 1000 + Err.Number, "CFtpConnection.EnumFiles", Err.Description
    GoTo Exit_Label
End Function

Public Function SetCurrentDirectory(strNewDirectory As String) As Boolean

    m_bBusy = True
    SetCurrentDirectory = ProcessCWDCommand(strNewDirectory)
    m_bBusy = False
    
End Function

Public Property Get FtpServer() As Variant
    FtpServer = m_varFtpServer
End Property

Public Property Let FtpServer(NewValue As Variant)
    m_varFtpServer = NewValue
End Property

Public Property Get Password() As String
    Password = m_strPassword
End Property

Public Property Let Password(NewValue As String)
    m_strPassword = NewValue
End Property

Public Property Get UserName() As String
    UserName = m_strUserName
End Property

Public Property Let UserName(NewValue As String)
    m_strUserName = NewValue
End Property

Public Function Connect() As Boolean
'********************************************************************************
'Author      :Oleg Gdalevich
'Date/Time   :28.12.99
'Purpose     :Establishes the connection to ftp server