cftpconnection.cls

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

        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
        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