frmmain.frm

用vb开发的ftp客服端

    picSplitter.Visible = False
    mbMoving = False
End Sub

Sub SizeControls(x As Single)
    
    On Error Resume Next

    'set the width
    If x < 1500 Then x = 1500
    If x > (Me.Width - 1500) Then x = Me.Width - 1500
    tvTreeView.Width = x
    imgSplitter.Left = x
    lvListView.Left = x + 40
    picTitle.Left = x + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    picTitle.Width = lvListView.Width - 20
    imgIcon.Left = picTitle.Width - imgIcon.Width - 40
    ProgressBar1.Width = picTitle.Width - ProgressBar1.Left - imgIcon.Width - 120
    Picture1.Left = ProgressBar1.Left + (ProgressBar1.Width - Picture1.Width)

    'set the top
  
    If CoolBar1.Visible Then
        tvTreeView.Top = CoolBar1.Height + 40
    Else
        tvTreeView.Top = 0
    End If
    
    picTitle.Top = tvTreeView.Top
    lvListView.Top = picTitle.Top + picTitle.Height
    
    'set the height
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - (IIf(CoolBar1.Visible, CoolBar1.Height, 0) + sbStatusBar.Height) - 40
    Else
        tvTreeView.Height = Me.ScaleHeight - IIf(CoolBar1.Visible, CoolBar1.Height, 0) - 40
    End If

    lvListView.Height = tvTreeView.Height - picTitle.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
    
    LockWindowUpdate 0
    
End Sub

Private Sub m_FtpConnection_DownloadProgress(lBytes As Long)

    On Error Resume Next

    sbStatusBar.Panels(1).Text = "Downloading " & m_strFile & " (" & lBytes & " bytes)"
    ProgressBar1.Value = lBytes / (m_lFileSize / 100)

End Sub

Private Sub m_FtpConnection_StateChanged(State As FTP_CONNECTION_STATES)
    
    Dim strStatus As String
    
    Select Case State
        Case FTP_CONNECTION_RESOLVING_HOST
            strStatus = "Resolving host..."
        Case FTP_CONNECTION_HOST_RESOLVED
            strStatus = "Host resolved"
        Case FTP_CONNECTION_CONNECTED
            strStatus = "Connected"
        Case FTP_CONNECTION_AUTHENTICATION
            strStatus = "Authentication..."
        Case FTP_USER_LOGGED
            strStatus = "You are logged in. Connection ready."
        Case FTP_ESTABLISHING_DATA_CONNECTION
            strStatus = "Establishing data connection..."
        Case FTP_DATA_CONNECTION_ESTABLISHED
            strStatus = "Data connection established."
        Case FTP_RETRIEVING_DIRECTORY_INFO
            strStatus = "Retrieving directory info..."
        Case FTP_DIRECTORY_INFO_COMPLETED
            strStatus = "Directory listing completed."
        Case State = FTP_TRANSFER_STARTING
            strStatus = "Transfer in progress..."
        Case FTP_TRANSFER_COMLETED
            strStatus = "Transfer completed."
            ProgressBar1.Value = 0.01
            m_lFileSize = 0
    End Select
    
    sbStatusBar.Panels(1).Text = strStatus
    
End Sub

Private Sub m_FtpConnection_UploadProgress(lBytes As Long)

    On Error Resume Next

    sbStatusBar.Panels(1).Text = "Uploading " & m_strFile & " (" & lBytes & " bytes)"
    ProgressBar1.Value = lBytes / (m_lFileSize / 100)

End Sub

Private Sub mnuConnect_Click()
    Call EstablishConnection
End Sub

Private Sub mnuCreateDir_Click()

    Dim strDirName As String
    
    strDirName = InputBox("Enter directory name, please.", "Create new directory")
    If Len(strDirName) > 0 Then
        If m_FtpConnection.CreateDirectory(strDirName) Then
            ListFiles tvTreeView.SelectedItem
        Else
            MsgBox "Can't create new directory." & vbCrLf & vbCrLf & _
                    "Server response: " & _
                    m_FtpConnection.GetLastServerResponse, , _
                    "Can't create directory"
        End If
    End If
    
End Sub

Private Sub mnuDelete_Click()
    '
    Dim intRetVal   As Integer
    Dim strFileName As String
    '
    On Error GoTo ERROR_HANDLER
    '
    strFileName = tvTreeView.SelectedItem.Key & lvListView.SelectedItem.Text
    '
    intRetVal = MsgBox("Do you really want to delete file " & strFileName & "?", vbYesNoCancel, "Delete file")
    '
    If intRetVal = vbYes Then
        If m_FtpConnection.DeleteFile(strFileName) Then
            ListFiles tvTreeView.SelectedItem
        Else
            MsgBox "Can't delete file." & vbCrLf & vbCrLf & _
                    "Server response: " & _
                    m_FtpConnection.GetLastServerResponse, , _
                    "Can't delete file"
        End If
    End If
    '
    Exit Sub
    '
ERROR_HANDLER:
    If Err = 91 Then
        MsgBox "Select file to rename, please.", vbInformation, "Rename File"
    Else
        MsgBox "Error occured!" & vbCrLf & "#" & Err.Number & ": " & Err.Description, _
                vbInformation, "Rename File"
    End If
    
End Sub

Private Sub mnuDownload_Click()
    Call DownloadFile
End Sub

Private Sub mnuEdit_Click()

    With m_FtpConnection
        mnuRename.Enabled = Not .Busy
        mnuRemoveDir.Enabled = Not .Busy
        mnuCreateDir.Enabled = Not .Busy
        mnuDelete.Enabled = Not .Busy
    End With
    
End Sub

Private Sub mnuFile_Click()

    With m_FtpConnection
        mnuDownload.Enabled = Not .Busy
        mnuUpload.Enabled = Not .Busy
    End With
    
End Sub

Private Sub mnuHelp_Click()

    mnuHelpAbout.Enabled = Not m_FtpConnection.Busy

End Sub

Private Sub mnuListViewMode_Click(Index As Integer)
        
    Select Case Index
        Case 0
            lvListView.View = lvwIcon
        Case 1
            lvListView.View = lvwSmallIcon
        Case 2
            lvListView.View = lvwList
        Case 3
            lvListView.View = lvwReport
    End Select
    
    tbToolBar.Buttons(15 + Index).Value = tbrPressed
    
End Sub

Private Sub mnuRemoveDir_Click()

    Dim intAnswer As Integer
    Dim CurNode As Node
    Dim i As Integer
    Dim intChildren As Integer
    
    On Error GoTo ERROR_HANDLER
    
    If Not tvTreeView.SelectedItem.Key = tvTreeView.SelectedItem.Root.Key Then
        intAnswer = MsgBox("Do you really want to remove directory: " & tvTreeView.SelectedItem.Text, vbQuestion + vbYesNo, "Remove Directory")
        If intAnswer = vbYes Then
            If m_FtpConnection.RemoveDirectory(tvTreeView.SelectedItem.Key) Then
                Set CurNode = tvTreeView.SelectedItem.Parent
                Set tvTreeView.SelectedItem = CurNode
                '
                'remove all children nodes of new selected node
                intChildren = CurNode.Children
                For i = 1 To intChildren
                    tvTreeView.Nodes.Remove CurNode.Child.Index
                Next i
                '
                ListFiles tvTreeView.SelectedItem
            Else
                MsgBox "Can't remove directory." & vbCrLf & vbCrLf & _
                        "Server response: " & _
                        m_FtpConnection.GetLastServerResponse, , _
                        "Can't remove directory"
            End If
        End If
    End If
    
    Exit Sub
    
ERROR_HANDLER:
    If Err = 91 Then
        MsgBox "Select file to rename, please.", vbInformation, "Rename File"
    Else
        MsgBox "Error occured!" & vbCrLf & "#" & Err.Number & ": " & Err.Description, _
                vbInformation, "Rename File"
    End If
    
    
End Sub

Private Sub mnuRename_Click()

    Dim strFileName     As String
    Dim strNewFileName  As String
    Dim intAnswer       As Integer
    '
    On Error GoTo ERROR_HANDLER
    '
    strFileName = lvListView.SelectedItem.Text
    '
    strNewFileName = InputBox("Enter new file name for " & strFileName, "Rename File")
    '
    If Len(strNewFileName) > 0 Then
        '
        intAnswer = MsgBox("Do you really want to rename file " & strFileName & " to " & strNewFileName & "?", _
                vbYesNo + vbQuestion, "Rename File")
        '
        If intAnswer = vbYes Then
            If m_FtpConnection.RenameFile(strFileName, strNewFileName) Then
                ListFiles tvTreeView.SelectedItem
            Else
                MsgBox "Can't rename file." & vbCrLf & vbCrLf & _
                        "Server response: " & _
                        m_FtpConnection.GetLastServerResponse, , _
                        "Can't rename file"
            End If
        End If
        '
    End If
    '
    Exit Sub
    '
ERROR_HANDLER:
    If Err = 91 Then
        MsgBox "Select file to rename, please.", vbInformation, "Rename File"
    Else
        MsgBox "Error occured!" & vbCrLf & "#" & Err.Number & ": " & Err.Description, _
                vbInformation, "Rename File"
    End If
    
End Sub

Private Sub mnuUpload_Click()
    
    Dim sFile       As String
    Dim bFileExists As Boolean
    Dim strFileName As String
    Dim lvItem      As ListItem
    Dim intRetVal   As Integer
    Dim lStartPoint As Long
    
    On Error Resume Next
        
    With dlgCommonDialog
        .DialogTitle = "Select file to upload"
        .CancelError = True
        .Filter = "All Files (*.*)|*.*"
        .ShowSave
        If Err = 0 Then
            If Len(.FileName) = 0 Then
                Exit Sub
            End If
            
            strFileName = Mid$(.FileName, InStrRev(.FileName, "\") + 1)
                    
            For Each lvItem In lvListView.ListItems
                If lvItem.Text = strFileName Then
                    bFileExists = True
                    Exit For
                End If
            Next
            
            m_lFileSize = FileLen(.FileName)
            
            If bFileExists Then
                If m_lFileSize > CLng(lvItem.SubItems(1)) Then
                    retVal = MsgBox("File " & strFileName & " already exists!" & vbCrLf & _
                                  "Size of remote file - " & lvItem.SubItems(1) & " bytes" & vbCrLf & _
                                  "Size of local file  - " & m_lFileSize & " 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 retVal = vbYes Then
                        lStartPoint = CLng(lvItem.SubItems(1))
                    ElseIf retVal = vbCancel Then
                        Exit Sub
                    End If
                Else
                    retVal = MsgBox("File " & strFileName & " already exists!" & vbCrLf & _
                                  "Size of remote file - " & lvItem.SubItems(1) & " bytes" & vbCrLf & _
                                  "Size of local file  - " & m_lFileSize & " bytes" & vbCrLf & vbCrLf & _
                                  "Do you want to cancel upload?" & vbclf & vbCrLf & _
                                  "Note: If you choose No new file will be created.", _
                                  vbYesNo + vbQuestion, "File already exists")
                    If retVal = vbYes Then
                        Exit Sub
                    End If
                End If
            End If
            
            m_strFile = strFileName
            If m_FtpConnection.UploadFile(.FileName, strFileName, lStartPoint) Then
                ListFiles tvTreeView.SelectedItem
            Else
                MsgBox "Can't upload file." & vbCrLf & vbCrLf & _
                        "Server response: " & m_FtpConnection.GetLastServerResponse, , "Can't upload file"
            End If
        End If
    End With

End Sub

Private Sub mnuView_Click()

    With m_FtpConnection
        mnuOptions.Enabled = Not .Busy
    End With
    
End Sub

Private Sub Option1_Click(Index As Integer)

    'm_FtpConnection.TransferMode = IIf(Index = 0, FTP_TYPE_ASCII, FTP_TYPE_IMAGE)

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)