ftp.frm

一个小型ftp服务器带码

         Size            =   15.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   5760
      TabIndex        =   7
      Top             =   360
      Width           =   2535
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "FTP Listing"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   15.75
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   360
      TabIndex        =   6
      Top             =   360
      Width           =   2535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdLoad_Click()
    Dim openFile As String                  ' This is to open a file for input
    Dim temp As String                      ' what is located in the open file for input
    Dim i As Integer                            ' for the file box records
    
    On Error GoTo error
    Dialog1.ShowOpen                           ' opens a dialog box
        openFile = Dialog1.FileName          ' sets "openfile" to the *.ftm you choose
        Open openFile For Input As #1      ' opens that file for input to collection box

    i = 0                                               ' inputs to the first record in the file box
    Do Until EOF(1)                               ' reads the input file until the end
     Input #1, temp
     Form3.filelist.List(i) = temp              ' puts the url into the url box
     Input #1, temp
     Form3.portbox.List(i) = temp           ' puts the port into the port box
     Input #1, temp
     Form3.namebox.List(i) = temp          ' puts the user name into the name box
     Input #1, temp
     Form3.passwordbox.List(i) = temp     ' puts the password into the paswd box
     i = i + 1                                            ' moves to the next record
    Loop
    
    Close #1                                        ' closes the input file
    Form3.Show
Exit Sub

error:
     If Dialog1.CancelError = False Then Exit Sub      ' if cancel is pressed
   MsgBox Err.Description, vbExclamation, "Error"     'otherwise display the error
End Sub

Private Sub cmdSave_Click()
    On Error GoTo error
    Dim Directory As String                         ' for the file that you chose

     If ftpAddress.Text = "" Then
         MsgBox "You have to enter a FTP address.", vbOKOnly + vbExclamation, "Invalid Information"
       Exit Sub
    ElseIf port.Text = "" Then
         MsgBox "You have to enter a port number.", vbOKOnly + vbExclamation, "Invalid Information"
       Exit Sub
    ElseIf usrName.Text = "" Then
        MsgBox "You have to enter a user name.", vbOKOnly + vbExclamation, "Invalid Information"
       Exit Sub
    ElseIf usrPassword.Text = "" Then
        MsgBox "You have to enter a password.", vbOKOnly + vbExclamation, "Invalid Information"
       Exit Sub
    End If

    Dialog1.ShowSave                                 ' shows the save dialog box

    Directory$ = Dialog1.FileName               ' path where it is saved is the one you chose
             
        On Error GoTo error
        
        Open Directory$ For Append As #1                ' opens the one you choose for output
              Print #1, ftpAddress.Text                     ' saves corosponding info to file you chose
              Print #1, port.Text
              Print #1, usrName.Text
              Print #1, usrPassword.Text
        Close #1                                                            ' closes the output file
    Exit Sub
error:
If Dialog1.CancelError = False Then Exit Sub            ' if error is pressed
MsgBox Err.Description, vbExclamation, "Error"          ' otherwise display error
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub connect_Click()
    On Error GoTo error:
        If ftpAddress.Text = "" Or port.Text = "" Or usrName.Text = "" Or usrPassword.Text = "" Then
              MsgBox "Please be sure that all FTP information is correct and try again.", vbOKOnly + vbExclamation, "Invalid Connection Information"
              Exit Sub
        End If
        
        Inet1.URL = ftpAddress.Text                     ' sets all inet properties
        Inet1.RemotePort = port.Text
        Inet1.UserName = usrName.Text
        Inet1.Password = usrPassword.Text
    
   message.Text = "Waiting for connection. . ."
    refresh_screen
Exit Sub

error:
    If Err.Number = 13 Then
        MsgBox "Please be sure that all FTP information is correct and try again.", vbOKOnly + vbExclamation, "Invalid Connection Information"
        message.Text = ""
    Exit Sub
    End If
    
    MsgBox Err.Description, vbExclamation, "Error"
    message.Text = ""
 
End Sub


Private Sub delete_Click()
Dim counter As Integer
couner = 0
On Error GoTo error
If Inet1.URL <> "" Then                             ' if there is an url present in the box
  While counter <= List1.ListCount - 1
        If List1.Selected(counter) = True Then         ' finds which file is selected in the FTP list box
            If (Left(List1.Text, 2) <> "./" Or Left(List1.Text, 3) <> "../" Or Right(List1.Text, 1) <> "/") Then         ' if it is a file (not a directory)
                Inet1.Execute , "DELETE " & List1.List(counter)          ' issues the DELETE command to ftp
                message.Text = "Deleting File: " & List1.List(counter)
            End If
        End If
        counter = counter + 1                           ' moves to next record and tries again
    Wend
     refresh_screen


Else: MsgBox "You are not connected to a FTP server!"           ' if no url present in the box
End If
    Exit Sub
    
error:
    
    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub


Private Sub Dir1_Change()
    File2.Path = Dir1               ' when you change directory on YOUR FILE side
End Sub


Private Sub disconnect_Click()
On Error GoTo error
     If Inet1.URL <> "" Then            ' if an url is present in the box
        Inet1.Execute , "CLOSE"          ' issues the QUIT command to ftp
        Inet1.URL = ""                  ' cleans out all inet information
        Inet1.UserName = ""
        Inet1.Password = ""
        message.Text = "Disconnected!"
    Else: MsgBox "You are not connected to a FTP server!"         ' if no URL is present
    End If
    Exit Sub
     
error:
    Select Case Err.Number
    Case 35764
    Inet1.Cancel
    message.Text = "Disconnected!"
    End Select
End Sub


Private Sub Download_Click()
Dim counter As Integer
Dim fileSize As String


On Error GoTo error
If Inet1.URL <> "" Then                         ' as long as url is present in box
    While counter < List1.ListCount         ' finds which one is selected in FTP list
        If List1.Selected(counter) = True Then
            If (Left(List1.Text, 2) <> "./" Or Left(List1.Text, 3) <> "../" Or Right(List1.Text, 1) <> "/") Then     ' if not a directory
                Inet1.Execute , "SIZE " & """" & List1.List(counter) & """"
                message.Text = "Retrieving file information..."
                fileSize = Inet1.GetChunk(1024)
                fileSize = List1.List(counter) & " is " & fileSize
                fileSize = fileSize & " bytes.  Do you want to continue?"
                continue = MsgBox(fileSize, vbYesNo, "Continue File Transfer")
                If continue = vbYes Then
                    message.Text = "Downloading File: " & List1.List(counter)
                    Inet1.Execute , "GET " & """" & List1.List(counter) & """" & " " & """" & Dir1.Path & "\" & List1.List(counter) & """" ' issues the GET command
                    File2.Refresh
                End If
            End If
        End If
        counter = counter + 1               ' moves to next record and tries again
    Wend
refresh_screen
File2.Refresh

Else: MsgBox "You are not connected to a FTP server!"       ' if no URL is present
End If
Exit Sub

error:

    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub


Private Sub Drive1_Change()
    Dir1.Path = Drive1
End Sub

Private Sub fileTransferHlp_DblClick()
    Dim helpstring As String
    helpstring = "File Transfer Help:" + vbLf + vbLf
    helpstring = helpstring & "     1. Enter all of the information into the ' ftp info ' boxes." + vbLf
    helpstring = helpstring & "     2. Press the ' connect to FTP server ' button." + vbLf
    helpstring = helpstring & "     3. Once files are shown in the ' ftp listing ' box, you are connected to the remote server." + vbLf + vbLf
    helpstring = helpstring & "     From this point you can do several things such as the following:" + vbLf
    helpstring = helpstring & "          1. Click ' Download '  to download the selected file from the ftp listing box ." + vbLf
    helpstring = helpstring & "          2. Click ' Upload ' to upload the selected file in your files." + vbLf
    helpstring = helpstring & "          3. Click ' Rename ' to rename the selected file in the ftp listing." + vbLf
    helpstring = helpstring & "          4. Click ' Delete ' to delete the selected file in the ftp listing." + vbLf
    helpstring = helpstring & "          5. Click ' Disconnect from FTP server ' to disconnect from the remote server." + vbLf + vbLf
    helpstring = helpstring & "     Please note that you may not have rights to do all of the" + vbLf
    helpstring = helpstring & "        above operations on every remote server." + vbLf + vbLf
    helpstring = helpstring & "     In addition, if you wish to do the above operations on more than one file," + vbLf
    helpstring = helpstring & "        you can multi-select files in the ' ftp listing ' and in ' your files '."
    MsgBox (helpstring)
End Sub

Private Sub Form_Load()
    Dim varTemp As Variant
End Sub


Public Sub refresh_screen()
On Error GoTo error
    Inet1.Execute , "DIR"                   ' issues the DIR command to ftp
    message.Text = "Connected and Ready!"
    varTemp = Inet1.GetChunk(1024)      ' pulls information from ftp server

    Dim strArray() As String
    Dim intTemp As Integer
    
    List1.Clear
    strArray = Split(CStr(varTemp), Chr(13) & Chr(10))
    List1.AddItem ("../")  ' to go one level up on non UNIX based stations
    For intTemp = 0 To UBound(strArray)
        List1.AddItem (strArray(intTemp))
   Next
Exit Sub

error:

    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub

Private Sub ftpInfoHlp_DblClick()
    Dim helpstring As String
    helpstring = "FTP Info Help:" + vbLf + vbLf
    helpstring = helpstring & "     These boxes are used to enter connection information into the program." + vbLf
    helpstring = helpstring & "     Please note that the most common (and default) FTP port is 21." + vbLf
    helpstring = helpstring & "     If no port is specified to you, try that default port number."
    MsgBox (helpstring)
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)

Select Case State
    Case 1
        message.Text = "Trying to resolve host..."
    Case 2
        message.Text = "Host is resolved"
    Case 3
        message.Text = "Sending connection request..."
    Case 9
        message.Text = "Disconnecting..."
    Case 10
        message.Text = "Disconnected"
    Case 11
        message.Text = "ERROR COMMUNICATING WITH HOST!"
    End Select
End Sub

Private Sub List1_DblClick()
On Error GoTo error
If Inet1.URL <> "" Then         ' if URL is present in box
    If (Left(List1.Text, 2) = "./" Or Left(List1.Text, 3) = "../" Or Right(List1.Text, 1) = "/") Then       ' if a directory (not a file)
        ' Clicking on the directory name
        message.Text = "Switching Directories. . ."
        Inet1.Execute , "cd " & List1.Text     ' issues cd command to selected directory in FTP box
        Inet1.Execute , "DIR"   ' issues the DIR command to ftp
        refresh_screen
     End If
Else: MsgBox "You are not connected to a FTP server!"       'if no URL is present
End If
Exit Sub

error:

    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub


Private Sub rename_Click()
On Error GoTo error
If Inet1.URL <> "" Then         ' if URL is present
    Dim namer As String
    namer = InputBox("What would you like to rename the file to: ")    ' for the NEW NAME of the file
    message.Text = "Renaming " & List1 & "To " & namer
    Inet1.Execute , "RENAME " & List1 & " " & namer      ' issues the RENAME command to ftp
    refresh_screen
Else: MsgBox "You are not connected to a FTP server!"       ' if URL is not present
End If
    Exit Sub
    
error:
  
    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub

Private Sub upload_Click()
Dim counter As Integer
counter = 0

On Error GoTo error
 If Inet1.URL <> "" Then            ' if URL is present
    While counter <= File2.ListCount - 1
        If File2.Selected(counter) = True Then      ' finds what file is selected in YOUR file list box
        Dim here As String
            Inet1.Execute , "PUT " & """" & File2.Path & "\" & File2.List(counter) & """" & " " & File2.List(counter)  ' issues the PUT command to ftp
            message.Text = "Uploading File: " & File2.List(counter)
            refresh_screen
        End If
        counter = counter + 1       ' moves to next record and tries again
    Wend

    refresh_screen
 Else: MsgBox "You are not connected to a FTP server!"      ' if no URL is present
 End If
Exit Sub

error:

    Select Case Err.Number
    Case 35764
    DoEvents
    Resume
    End Select
End Sub