ftp.frm

ftp 控件 ftp 控件

Private Sub Form_Load()
    
    Me.Move (Screen.Width \ 2) - (Me.Width \ 2), (Screen.Height \ 2) - (Me.Height \ 2)
    FirstTime = False
    FTP.Binary = True
    FTP.UseCache = False
    
End Sub


Private Sub Form_Unload(Cancel As Integer)

    FTP.Disconnect
    
End Sub



Private Sub FTP_NextDirectoryEntry(ByVal FileName As String, ByVal Attributes As Long, ByVal Length As Double)

    If (Attributes And 16) = 16 Or Attributes = 0 Then
        RemoteDirectories.AddItem FileName
    Else
        RemoteFiles.AddItem FileName
    End If
    
End Sub



Private Sub FTP_TransferProgress(ByVal BytesTransferred As Long, ByVal TotalBytes As Long)

    If CancelFlag = True Then
        FTP.CancelTransfer = True
    End If
    
    If ProgressBar.Max = 1 Then
        ProgressBar.Max = TotalBytes
    End If
    ProgressBar.Value = BytesTransferred
    DoEvents ' to give the cancel button a chance

End Sub


Private Sub LocalCD_Click()

Dim NewDirectory As String

    NewDirectory = InputBox$("Enter directory to change to")
    If NewDirectory = "" Then
        Exit Sub
    End If

    On Error Resume Next
    ChDir NewDirectory
    If Err <> 0 Then
        MsgBox "Unable to change directory", vbExclamation
    Else
        RefreshLocal
    End If
    
End Sub

Private Sub LocalDEL_Click()
    
    If LocalFiles.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    On Error Resume Next
    Kill LocalFiles.Text
    If Err <> 0 Then
        MsgBox "Unable to delete local file", vbExclamation
    Else
        RefreshLocal
    End If

End Sub

Private Sub LocalDirectories_DblClick()

    If LocalDirectories.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    ChDir LocalDirectories.Text
    RefreshLocal
    
End Sub


Private Sub LocalFiles_DblClick()

    ToRemote.Value = 1
    
End Sub


Private Sub LocalMD_Click()

Dim NewDirectory As String
    
    NewDirectory = InputBox$("Enter new directory name")
    If NewDirectory = "" Then
        Exit Sub
    End If
    
    On Error Resume Next
    MkDir NewDirectory
    If Err <> 0 Then
        MsgBox "Unable to make local directory", vbExclamation
    Else
        RefreshLocal
    End If

End Sub

Private Sub LocalRD_Click()
    
    If LocalDirectories.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    On Error Resume Next
    RmDir LocalDirectories.Text
    If Err <> 0 Then
        MsgBox "Unable to remove local directory", vbExclamation
    Else
        RefreshLocal
    End If

End Sub

Private Sub RemoteCD_Click()

Dim NewDirectory As String

    NewDirectory = InputBox$("Enter directory to change to")
    If NewDirectory = "" Then
        Exit Sub
    End If
    
    On Error Resume Next
    FTP.RemoteDirectory = NewDirectory
    If Err <> 0 Then
        MsgBox "Unable to change directory", vbExclamation
    Else
        RefreshRemote
    End If
        
End Sub

Private Sub RemoteDEL_Click()

    If RemoteFiles.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    On Error Resume Next
    FTP.DeleteFile RemoteFiles.Text
    If Err <> 0 Then
        MsgBox "Unable to delete remote file", vbExclamation
    Else
        RefreshRemote
    End If
    
End Sub

Private Sub RemoteDirectories_DblClick()

    On Error Resume Next
    FTP.RemoteDirectory = RemoteDirectories.Text
    If Err <> 0 Then
        MsgBox "Unable to change directory", vbExclamation
    Else
        RefreshRemote
    End If
    
End Sub


Private Sub RemoteFiles_DblClick()

    ToLocal.Value = 1
    
End Sub


Private Sub RemoteMD_Click()

Dim NewDirectory As String
    
    NewDirectory = InputBox$("Enter new directory name")
    If NewDirectory = "" Then
        Exit Sub
    End If
    
    On Error Resume Next
    FTP.MkDir NewDirectory
    If Err <> 0 Then
        MsgBox "Unable to make remote directory", vbExclamation
    Else
        RefreshRemote
    End If
    

End Sub

Private Sub RemoteRD_Click()

    If RemoteDirectories.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    On Error Resume Next
    FTP.RmDir RemoteDirectories.Text
    If Err <> 0 Then
        MsgBox "Unable to remove remote directory", vbExclamation
    Else
        RefreshRemote
    End If
    
End Sub

Private Sub ToLocal_Click()

    If RemoteFiles.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    FTP.RemoteFile = RemoteFiles.Text
    FTP.LocalFile = RemoteFiles.Text
    Screen.MousePointer = vbHourglass
    
'Fancy stuff for the Pro Edition
    If FTP.ProfessionalEdition = True Then
        BinaryMode.Visible = False
        ASCIIMode.Visible = False
        ProgressBar.Visible = True
        ProgressBar.Value = 0
        ProgressBar.Max = 1
        CancelFlag = False
        About.Caption = "&Cancel"
        DoEvents
    End If
    
    On Error Resume Next
    FTP.GetFile
    Screen.MousePointer = vbDefault
    If Err <> 0 Then
        MsgBox "Unable to transfer from remote system", vbExclamation
    Else
        If CancelFlag = True Then
            On Error GoTo 0
            Screen.MousePointer = vbHourglass
            FTP.Disconnect
            FTP.Connect
            FTP.RemoteDirectory = RemotePWD.Caption
            CancelFlag = False
            Screen.MousePointer = vbDefault
        End If
        Beep
        RefreshLocal
    End If
    
    If FTP.ProfessionalEdition = True Then
        BinaryMode.Visible = True
        ASCIIMode.Visible = True
        ProgressBar.Visible = False
        About.Caption = "&About"
    End If
    
End Sub


Private Sub ToRemote_Click()

    If LocalFiles.ListIndex = -1 Then
        Beep
        Exit Sub
    End If
    
    FTP.LocalFile = LocalFiles.Text
    FTP.RemoteFile = LocalFiles.Text

'Fancy stuff for the Pro Edition
    If FTP.ProfessionalEdition = True Then
        BinaryMode.Visible = False
        ASCIIMode.Visible = False
        ProgressBar.Visible = True
        ProgressBar.Value = 0
        ProgressBar.Max = 1
        CancelFlag = False
        About.Caption = "&Cancel"
        DoEvents
    End If
    
    Screen.MousePointer = vbHourglass
    On Error Resume Next
    FTP.PutFile
    Screen.MousePointer = vbDefault
    If Err <> 0 Then
        MsgBox "Unable to transfer to remote system", vbExclamation
    Else
        If CancelFlag = True Then
            On Error GoTo 0
            Screen.MousePointer = vbHourglass
            FTP.Disconnect
            FTP.Connect
            FTP.RemoteDirectory = RemotePWD.Caption
            CancelFlag = False
            Screen.MousePointer = vbDefault
        End If
        Beep
        RefreshRemote
    End If
    
    If FTP.ProfessionalEdition = True Then
        BinaryMode.Visible = True
        ASCIIMode.Visible = True
        ProgressBar.Visible = False
        About.Caption = "&About"
    End If
    
End Sub