frmmain.frm

用vb开发的ftp客服端

    
    Dim strTemp As String
    
    On Error Resume Next
    Select Case Button.Key
        Case "Connect"
            Call EstablishConnection
        Case "UpLevel"
            Set tvTreeView.SelectedItem = tvTreeView.SelectedItem.Parent
            strTemp = tvTreeView.SelectedItem.FullPath
            strTemp = Mid$(strTemp, InStr(1, strTemp, "/"))
            If m_FtpConnection.SetCurrentDirectory(strTemp) Then
                ListFiles tvTreeView.SelectedItem
            End If
        Case "Stop"
            If Not m_FtpConnection.CloseConnection Then
                If m_FtpConnection.FtpGetLastError = ERROR_FTP_USER_TRANSFER_IN_PROGRESS Then
                    Dim intRetVal As Integer
                    intRetVal = MsgBox("Data transfer in progress. Do you want to cancel the data transfer?", vbYesNo + vbQuestion)
                    If intRetVal = vbYes Then
                        m_FtpConnection.CancelTransfer
                    End If
                End If
            End If
        Case "Refresh"
            Call RefreshDirectory
        Case "Download"
            mnuDownload_Click
        Case "Upload"
            mnuUpload_Click
        Case "CreateDirectory"
            mnuCreateDir_Click
        Case "Delete"
            mnuDelete_Click
        Case "Rename"
            mnuRename_Click
        Case "View Large Icons"
            lvListView.View = lvwIcon
        Case "View Small Icons"
            lvListView.View = lvwSmallIcon
        Case "View List"
            lvListView.View = lvwList
        Case "View Details"
            lvListView.View = lvwReport
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    CoolBar1.Visible = mnuViewToolbar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuFileClose_Click()
    'unload the form
    Unload Me
End Sub

Public Function GetImageNumber(strFileName As String) As Integer

    Dim iPos As Integer
    Dim strExt As String
    
    strExt = Mid$(strFileName, InStrRev(strFileName, ".") + 1)
    
    On Error Resume Next
    
    Select Case LCase(strExt)
        Case "txt", "htm", "html", "lst", "log", "ini", "inf", ""
            GetImageNumber = 1
        Case Else
            GetImageNumber = 2
    End Select
        
End Function

Public Function FormatFileSize(lFileSize As Long) As String
    
    On Error GoTo ERROR_HANDLER
    
    If lFileSize >= 1024 Then
        FormatFileSize = Format$(CStr(lFileSize / 1024), "### ### ### KB")
    Else
        FormatFileSize = CStr(lFileSize) & " " & "bytes"
    End If

    Exit Function
    
ERROR_HANDLER:
    Debug.Print Err.Number & " " & Err.Description
    
End Function

Private Sub tvTreeView_DragDrop(Source As Control, x As Single, y As Single)
    If Source = imgSplitter Then
        SizeControls x
    End If
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    
With m_FtpConnection
    If .Busy Then
        Set tvTreeView.SelectedItem = m_LastNode
        Exit Sub
    End If
    
    Set m_LastNode = Node
    
TryAgain:
    If .SetCurrentDirectory(Replace$(Mid$(Node.FullPath, InStr(1, Node.FullPath, "/")), "//", "/")) Then
        ListFiles Node
    Else
        If .FtpGetLastError = ERROR_FTP_WINSOCK_BadState Then
            If .Connect Then
                GoTo TryAgain
            End If
        Else
        
        End If
    End If
    
End With
    
End Sub

Private Sub AddFileToListView(oFtpFile As CFtpFile)
    
    Dim intIcon     As Integer
    Dim strFileName As String
    
    strFileName = oFtpFile.FileName
    
    intIcon = GetImageNumber(strFileName)
    Set lvItem = lvListView.ListItems.Add(, strFileName, strFileName, intIcon, intIcon)
    lvItem.SubItems(1) = oFtpFile.FileSize
    lvItem.SubItems(2) = oFtpFile.LastWriteTime
    
End Sub

Private Sub DownloadFile()
    
    On Error Resume Next
    
    Dim lStartPoint         As Long
    Dim bForceDownload      As Boolean
    Dim vTransferMode       As FtpTransferModes
    
    With dlgCommonDialog
        'show to the user the dialog to choose file name to save
        .DialogTitle = "Download file and save as..."
        .CancelError = True
        .Filter = "All Files (*.*)|*.*"
        .FileName = lvListView.SelectedItem.Text
        .ShowSave
        If Err = 0 Then
            If Len(.FileName) = 0 Then
                'user has clicked Cancel button
                Exit Sub
            End If
            'get remote file name
            m_strFile = lvListView.SelectedItem.Text
            'get size of remote file
            m_lFileSize = CLng(lvListView.SelectedItem.SubItems(1))
            '
            'get transfer mode
            If CBool(Option1(0).Value) Then
                vTransferMode = FTP_ASCII_MODE
            Else
                vTransferMode = FTP_IMAGE_MODE
            End If
                        
            If FileExists(.FileName) Then
                '
                Dim strQuestion As String
                Dim intRetVal   As Integer
                '
                If FileLen(.FileName) < m_lFileSize Then
                    intRetVal = MsgBox("File " & .FileName & " already exists!" & vbCrLf & _
                                  "Size of remote file - " & m_lFileSize & " bytes" & vbCrLf & _
                                  "Size of local file  - " & FileLen(.FileName) & " bytes" & vbCrLf & vbCrLf & _
                                  "Do you want to append lost data to existing file?" & vbclf & vbCrLf & _
                                  "Note: If you choose No new file will be created.", _
                                  vbYesNoCancel + vbQuestion, "File already exists")
                    If intRetVal = vbYes Then
                        lStartPoint = FileLen(.FileName)
                    ElseIf intRetVal = vbCancel Then
                        Exit Sub
                    End If
                Else    'FileLen(.FileName) < m_lFileSize
                    intRetVal = MsgBox("File " & .FileName & " already exists!" & vbCrLf & _
                                  "Size of remote file - " & m_lFileSize & " bytes" & vbCrLf & _
                                  "Size of local file  - " & FileLen(.FileName) & " bytes" & vbCrLf & vbCrLf & _
                                  "Do you want to cancel download?" & vbclf & vbCrLf & _
                                  "Note: If you choose No new file will be created.", _
                                  vbYesNo + vbQuestion, "File already exists")
                    If intRetVal = vbYes Then
                        Exit Sub
                    End If
                End If  'FileLen(.FileName) < m_lFileSize
            End If  'FileExists(.FileName)
            'download file
TryAgain:
            If Not m_FtpConnection.DownloadFile(m_strFile, .FileName, _
                        vTransferMode, lStartPoint) Then
                If m_FtpConnection.FtpGetLastError = ERROR_FTP_WINSOCK_BadState Then
                    'we have lost control connection
                    intRetVal = MsgBox("The connection is broken. Do you wish to establish the connect again?", vbQuestion + vbYesNo)
                    If intRetVal = vbYes Then
                        If m_FtpConnection.Connect Then
                            If m_FtpConnection.SetCurrentDirectory(tvTreeView.SelectedItem.FullPath) Then
                                GoTo TryAgain
                            End If
                        Else
                            MsgBox "The connection cannot be established.", vbExclamation
                        End If
                    Else
                        Call ResetProgress
                    End If
                ElseIf m_FtpConnection.FtpGetLastError = ERROR_FTP_USER_TIMEOUT Then
                    intRetVal = MsgBox("Server doesn't response. Do you like to try again?", vbYesNo + vbQuestion)
                    If intRetVal = vbYes Then
                        GoTo TryAgain
                    Else
                        Call ResetProgress
                    End If
                Else
                    MsgBox "Error #" & m_FtpConnection.FtpGetLastError & vbCrLf & vbCrLf & _
                            m_FtpConnection.GetFtpErrorDescription, vbExclamation
                End If
            End If
        End If
    End With

End Sub

Private Function FileExists(strFileName As String) As Boolean
    
    On Error GoTo ERROR_HANDLER
    
    FileExists = (GetAttr(strFileName) And vbDirectory) = 0

ERROR_HANDLER:
    
End Function

Private Sub RefreshDirectory()
    
    With tvTreeView.SelectedItem
        '
        'remove all subfolders from treeview
        '
        If .Children > 0 Then
            For i = 1 To .Children
                tvTreeView.Nodes.Remove (.Child.Index)
            Next i
        End If
        '
        lvListView.ListItems.Clear
        '
        ListFiles tvTreeView.SelectedItem
        '
    End With
    
End Sub

Private Sub EstablishConnection()

Dim tvNode As Node
'Dim CurNode As Node
'create instance of frmConnect form
Dim f As New frmConnect
'show the form
f.Show vbModal
'if OK button was clicked
If f.Action = comdOK Then
    'clear the treeview and the listview
    tvTreeView.Nodes.Clear
    lvListView.ListItems.Clear
    '
    With m_FtpConnection
        'init object properties
        .FtpServer = f.URL
        .UserName = f.UserName
        .Password = f.Password
        .PassiveMode = CBool(Check1.Value)
        'call Connect method
        If .Connect Then
            Label1 = f.URL
            'add root node to the treeview
            Set tvNode = tvTreeView.Nodes.Add(, , , .CurrentDirectory, 1)
            tvNode.Key = .CurrentDirectory
            Set tvTreeView.SelectedItem = tvNode
            ListFiles tvNode, True
        End If '.Connect
    End With 'm_FtpConnection
End If 'f.Action = comdOK

End Sub

Private Sub ListFiles(Optional oNode As Node, Optional bRoot As Boolean = False)

    Dim CurNode As Node
    Dim tvNode As Node
    Dim strNewKey As String
    
    On Error Resume Next

    lvListView.ListItems.Clear

    With m_FtpConnection
        .PassiveMode = CBool(Check1.Value)
        'if connection established
        Dim oFiles As New CFtpFiles
        Dim oFile As CFtpFile
        'enumerate files in root dir
        If .EnumFiles(oFiles) Then
            Set oFiles = oFiles
            'if quantity is 1 or more
            If oFiles.Count > 0 Then
                'walk thru all files in the collection
                For Each oFile In oFiles
                    If oFile.IsDirectory Then
                        'if found item is directory
                        'add new child node
                        If oNode.Key = oNode.Root.Key Then
                            If Not oNode.Key = "/" Then
                                strNewKey = oNode.Key & "/" & oFile.FileName & "/"
                            Else
                                strNewKey = oNode.Key & oFile.FileName & "/"
                            End If
                        Else
                            strNewKey = oNode.Key & oFile.FileName & "/"
                        End If
    
                        Set tvNode = tvTreeView.Nodes.Add(oNode.Key, tvwChild, strNewKey, oFile.FileName, 2)
                        'tvNode.Key = Mid$(tvNode.FullPath, InStr(1, tvNode.FullPath, "/"))
                        tvNode.ExpandedImage = 3
                    Else
                        'if found item is file
                        'add new item to the listview
                        If tvTreeView.SelectedItem.Key = oNode.Key Then
                            AddFileToListView oFile
                        End If
                    End If 'oFile.IsDirectory
                Next
            End If 'oFiles.Count > 0
        Else
            MsgBox "Error #" & m_FtpConnection.FtpGetLastError & vbCrLf & vbCrLf & _
            m_FtpConnection.GetFtpErrorDescription, vbExclamation
        End If
    End With 'm_FtpConnection
    
    oNode.Expanded = True

End Sub

Private Sub ResetProgress()

    ProgressBar1.Value = 0
    sbStatusBar.Panels(1).Text = ""
    
End Sub