Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/fssock20/ftpdemo.frm

Visual Basic Form | 1996-11-20 | 28.6 KB | 827 lines

VERSION 2.00
Begin Form FtpDemo
   BorderStyle     =   1  'Fixed Single
   Caption         =   "FtpDemo"
   ClientHeight    =   7815
   ClientLeft      =   1200
   ClientTop       =   1605
   ClientWidth     =   8145
   Height          =   8220
   Left            =   1140
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7815
   ScaleWidth      =   8145
   Top             =   1260
   Width           =   8265
   Begin Frame Frame6
      Caption         =   "Transfer Type"
      Height          =   615
      Left            =   2400
      TabIndex        =   21
      Top             =   4680
      Width           =   3375
      Begin OptionButton Binary_Option
         Caption         =   "BINARY"
         Height          =   255
         Left            =   2025
         TabIndex        =   23
         Top             =   240
         Width           =   1095
      End
      Begin OptionButton ASCII_Option
         Caption         =   "ASCII"
         Height          =   255
         Left            =   480
         TabIndex        =   22
         Top             =   240
         Value           =   -1  'True
         Width           =   855
      End
   End
   Begin Frame Frame5
      Caption         =   "Login Information"
      Height          =   2535
      Left            =   2400
      TabIndex        =   17
      Top             =   2160
      Width           =   3375
      Begin FSSocket FtpXfrData
         Connect         =   0   'False
         EOL             =   ""
         HostAddress     =   ""
         HostName        =   ""
         InputBufferSize =   8192
         Left            =   2880
         Listen          =   0   'False
         ListenPort      =   0
         OutputBufferSize=   8192
         PortNumber      =   0
         Protocol        =   0  'TCP
         ServiceName     =   ""
         Top             =   1200
      End
      Begin Timer Logout_Timer
         Left            =   2280
         Top             =   240
      End
      Begin FSSocket FtpCommand
         Connect         =   0   'False
         EOL             =   ""
         HostAddress     =   ""
         HostName        =   ""
         InputBufferSize =   8192
         Left            =   2880
         Listen          =   0   'False
         ListenPort      =   0
         OutputBufferSize=   8192
         PortNumber      =   0
         Protocol        =   0  'TCP
         ServiceName     =   ""
         Top             =   240
      End
      Begin FSSocket FtpDirData
         Connect         =   0   'False
         EOL             =   ""
         HostAddress     =   ""
         HostName        =   ""
         InputBufferSize =   8192
         Left            =   2880
         Listen          =   0   'False
         ListenPort      =   0
         OutputBufferSize=   8192
         PortNumber      =   0
         Protocol        =   0  'TCP
         ServiceName     =   ""
         Top             =   720
      End
      Begin TextBox Hostname
         Height          =   285
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   3135
      End
      Begin TextBox Userid
         Height          =   285
         Left            =   120
         TabIndex        =   2
         Top             =   1080
         Width           =   3135
      End
      Begin TextBox Password
         Height          =   285
         Left            =   120
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   1680
         Width           =   3135
      End
      Begin CommandButton ConnectButton
         Caption         =   "Connect"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   2040
         Width           =   1455
      End
      Begin CommandButton ListRefreshButton
         Caption         =   "List Directory"
         Enabled         =   0   'False
         Height          =   375
         Left            =   1800
         TabIndex        =   4
         Top             =   2040
         Width           =   1455
      End
      Begin Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Host Name"
         Height          =   195
         Left            =   120
         TabIndex        =   20
         Top             =   240
         Width           =   945
      End
      Begin Label Label2
         AutoSize        =   -1  'True
         Caption         =   "Userid"
         Height          =   195
         Left            =   120
         TabIndex        =   19
         Top             =   840
         Width           =   555
      End
      Begin Label Label3
         AutoSize        =   -1  'True
         Caption         =   "Password"
         Height          =   195
         Left            =   120
         TabIndex        =   18
         Top             =   1440
         Width           =   825
      End
   End
   Begin Frame Frame4
      Caption         =   "Commands"
      Height          =   2415
      Left            =   120
      TabIndex        =   15
      Top             =   5280
      Width           =   7935
      Begin TextBox CommandWindow
         Height          =   2055
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   16
         TabStop         =   0   'False
         Top             =   240
         Width           =   7695
      End
   End
   Begin Frame Frame3
      Caption         =   "Remote System"
      Height          =   5175
      Left            =   5880
      TabIndex        =   13
      Top             =   120
      Width           =   2175
      Begin ComboBox Remote_Current_Directory
         Height          =   300
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   1935
      End
      Begin ListBox Remote_Directory
         Height          =   1590
         Left            =   120
         Sorted          =   -1  'True
         TabIndex        =   7
         Top             =   600
         Width           =   1935
      End
      Begin ListBox Remote_File_List
         Height          =   2760
         Left            =   120
         Sorted          =   -1  'True
         TabIndex        =   6
         Top             =   2280
         Width           =   1935
      End
   End
   Begin Frame Frame2
      Caption         =   "Local System"
      Height          =   5175
      Left            =   120
      TabIndex        =   12
      Top             =   120
      Width           =   2175
      Begin DirListBox Local_Directory
         Height          =   1380
         Left            =   120
         TabIndex        =   9
         Top             =   600
         Width           =   1935
      End
      Begin FileListBox Local_File_List
         Height          =   2955
         Left            =   120
         TabIndex        =   8
         Top             =   2040
         Width           =   1935
      End
      Begin DriveListBox Local_Drive
         Height          =   315
         Left            =   120
         TabIndex        =   10
         Top             =   240
         Width           =   1935
      End
   End
   Begin Frame Frame1
      Caption         =   "FTP Demo"
      Height          =   1935
      Left            =   2400
      TabIndex        =   0
      Top             =   120
      Width           =   3375
      Begin TextBox Text1
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   1575
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   240
         Width           =   3135
      End
   End
Option Explicit
Dim listport As String          'address and port for directory listing
Dim xfrport As String           'address and port for data transfers
Dim reply As String             'field to host command replies from the server
Dim download_file As Integer    'file number for downloading files
Dim upload_file As Integer      'file number for uploading files
Dim ready_to_send As Integer    'is the socket ready to send?
Dim connected As Integer        'are we connected?
Dim client_mode As String       'Current client transfer mode 'a' or 'i'
Dim server_mode As String       'Current server transfer mode
Private Sub ASCII_Option_Click ()
Rem Set file transfer type to "ascii"
    client_mode = "a"
End Sub
Private Sub Binary_Option_Click ()
Rem Set file transfer type to "image"
    client_mode = "i"
End Sub
Private Sub ChangeCurrentDirectory (directory As String)
Dim firstquote As Integer
Dim secondquote As Integer
Dim index As Integer
Dim newdir As String
Rem If there is a new directory to goto, send a "cwd" command to the server
    If directory <> "" Then
        Send_Command ("cwd " & directory)
    End If
Rem Send a "pwd" command to get the current directory on the server.
    Send_Command ("pwd")
Rem Reply looks like '2xx "dir/dir/dir" text message'
Rem Get the data between the quotes.
    firstquote = InStr(1, reply, Chr$(34)) + 1
    secondquote = InStr(firstquote, reply, Chr$(34))
    newdir = Mid$(reply, firstquote, secondquote - firstquote)
Rem Search the Remote_Current_Directory combo box for a match.
    For index = 0 To Remote_Current_Directory.ListCount - 1
        If newdir = Remote_Current_Directory.List(index) Then
            Remote_Current_Directory.Text = Remote_Current_Directory.List(index)
        End If
    Next index
Rem If no match add it to the Remote_Current_Directory combo box and make
Rem it the current selection.
    If Remote_Current_Directory.Text <> newdir Then
        Remote_Current_Directory.AddItem newdir
        Remote_Current_Directory.Text = Remote_Current_Directory.List(Remote_Current_Directory.NewIndex)
    End If
End Sub
Private Sub ConnectButton_Click ()
    If ConnectButton.Caption = "Connect" Then
        On Error GoTo nohost:   ' catch bad host names
Rem Set the default mode to ASCII
        ASCII_Option.Value = True
        client_mode = "a"
        server_mode = "a"

Rem Set the hostname.
        ftpcommand.HostName = HostName.Text
Rem set the protocol.
        ftpcommand.ServiceName = "ftp"
Rem Clear the reply string.
        reply = ""

Rem Show that we are connecting
        ConnectButton.Caption = "Working"
Rem Connect to the server.
        ftpcommand.Connect = True

Rem Wait for the server to connect and send us a message
        While reply = ""
            DoEvents
        Wend

Rem Some replies have a "-" in col 4, This means there is more to come
Rem so skip over them.
        While Mid$(reply, 4, 1) = "-"
            DoEvents
        Wend
Rem Make the list button active.
        ListRefreshButton.Enabled = True

Rem Send the userid.
        Send_Command ("user " & userid.Text)

Rem Replys that begin with "5xx" are errors.
        If Left$(reply, 1) = "5" Then
            MsgBox reply
Rem Login failed, so tell the server we are done.
            Send_Command ("quit")
            Exit Sub
        End If
Rem Send the password.
        Send_Command ("pass " & password.Text)
        If Left$(reply, 1) = "5" Then
            MsgBox reply
            Send_Command ("quit")
            Exit Sub
        End If
Rem Call ChangeCurrentDirectory to update the Remote_Current_Directory combo box.
        ChangeCurrentDirectory ("")

Rem List the remote directory.
        ListCurrentDirectory

Rem Set the default xfer type to "ascii"

        Send_Command ("type a")
    Else
Rem Send the "quit" command to the server.
        Send_Command ("quit")
Rem Sometimes we may be out of sync with the server and it will
Rem not respond to the "quit". So we set a timer for 5 seconds.
Rem The timer will close all connections from the client side.
        Logout_Timer.Interval = 5000
    End If
    Exit Sub
nohost:
Rem Bad host name, so tell the user.
    If Err = 20102 Then
        MsgBox ftpcommand.WSALastErrorMsg
    Else
        MsgBox Error
    End If
    Exit Sub
End Sub
Private Sub Form_Load ()
    FtpDemo.Caption = FtpDemo.Caption & " - " & ftpcommand.WSADescription
Rem We want to break up the responses from the server into lines.
    FtpDirData.EOL = Chr$(13) & Chr$(10)
    ftpcommand.EOL = Chr$(13) & Chr$(10)
    text1.Text = "This is not meant to be a complete FTP program."
    text1.Text = text1.Text & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "It's purpose is to show some of the basic logic required to create one."
    text1.Text = text1.Text & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "For more information on FTP you should read RFC959.TXT"
End Sub
Private Sub FtpCommand_Connected (StatusCode As Integer, Description As String)
Rem We have connected to a server, make the connect button into a
Rem disconnect button.
    ConnectButton.Caption = "Disconnect"
    connected = True
End Sub
Private Sub FtpCommand_DataReceived (Text As String, EOL As Integer)
Rem When this event is fired, the data received in the Text string
Rem may not be complete. If EOL is not True, only a partial line
Rem of data has been received. We store this incomplete data in a
Rem static string called "line".  Only when EOL is True can we
Rem proccess the data.
    Static data_line As String
    data_line = data_line & Text
    If EOL = True Then
Rem Show the data received in the command window
        CommandWindow.SelStart = Len(CommandWindow.Text)
        CommandWindow.SelText = data_line & Chr$(13) & Chr$(10)
        reply = data_line
        data_line = ""
    End If
End Sub
Private Sub FtpCommand_Disconnected (StatusCode As Integer, Description As String)
Rem If we are attempting a "new" connection, display the reason for the failure
Rem to connect.
    If ConnectButton.Caption = "Working" Then
        MsgBox Description
    End If
Rem Mark us disconnected
    connected = False
Rem Stop listening for data
    FtpDirData.Listen = False
    FtpXfrData.Listen = False
Rem Disable the list button
    ListRefreshButton.Enabled = False
Rem clear the server directory info
    Remote_Directory.Clear
    Remote_Directory.AddItem ".."
    Remote_File_List.Clear
    Remote_Current_Directory.Clear
Rem Stop the timer, it one was runing.
    Logout_Timer.Interval = 0
Rem Make this a connect button
    ConnectButton.Caption = "Connect"
End Sub
Private Sub ftpdirdata_DataReceived (Text As String, EOL As Integer)
Rem When this event is fired, the data received in the Text string
Rem may not be complete. If EOL is not True, only a partial line
Rem of data has been received. We store this incomplete data in a
Rem static string called "data_line".  Only when EOL is True can we
Rem proccess the data.
    Dim a As Integer            ' field count
    Dim pos As Integer
    Dim entry_name As String          ' the entry name
    Dim firstchar As String     ' the first character of the directory entry
    Static data_line As String       ' where we build the directory entry
Rem Add the new data to the line we are working on
    data_line = data_line & Text
    If EOL = True Then
Rem We now have a complete line of directory information sent from the
Rem server.
Rem On some systems, the server will return extra lines of data
Rem such as the count of files.
Rem If it not an entry, just ignore it.
        firstchar = Mid$(data_line, 1, 1)
        If firstchar <> "d" And firstchar <> "l" And firstchar <> "-" Then
            data_line = ""
            Exit Sub
        End If

Rem Find the entry name, in the 9th field
        pos = 1
        For a = 1 To 8
            pos = InStr(pos, data_line, " ")
            'skip multiple blanks
            While Mid$(data_line, pos, 1) = " "
                pos = pos + 1
            Wend
            entry_name = Mid$(data_line, pos)
        Next a


Rem Look at the type for this entry and add it to the correct list.
        Select Case firstchar
        Case "d"
Rem It is a directory.
Rem Only add real directory names, not all servers send the ".."
Rem entry, so we took care of that elsewhere.
            If entry_name <> ".." Or entry_name <> "." Then
                Remote_Directory.AddItem entry_name
            End If
        Case "l"
Rem It is a link, remove the link info before saving.
            Remote_Directory.AddItem Left$(entry_name, InStr(1, entry_name, " ->") - 1)
        Case "-"
Rem It is a file.
            Remote_File_List.AddItem entry_name
        End Select

Rem Done with this line, clear it.
        data_line = ""
    End If
End Sub
Private Sub FtpDirData_Disconnected (StatusCode As Integer, Description As String)
Rem Close the listen connection.
Rem We need to do this because the server keeps the old port
Rem open for a while.
    FtpDirData.Listen = False
End Sub
Private Sub FtpXfrData_Connected (StatusCode As Integer, Description As String)
    Dim buffer As String
    Dim file_length As Long
    Dim curpos As Long
    Dim buflen As Integer
Rem If we are not uploading a file, do nothing
    If upload_file = 0 Then
        Exit Sub
    End If
Rem Set up to catch failed sends (10035 WSAWOULDBLOCK)
    On Error GoTo delay:
Rem Get the length of the file and our current possition in the file
    file_length = LOF(upload_file)
    curpos = Seek(upload_file)
Rem set our send size to 1/2 the Output buffer size.
    buflen = FtpXfrData.OutputBufferSize / 2
Rem while there is more data to send
    Do While curpos <= file_length
Rem     Don't go past the end of the file
        If curpos + buflen > file_length Then
            buflen = file_length - curpos + 1
        End If
Rem     Read in buflen bytes from the file
        buffer = String$(buflen, " ")
        Get #upload_file, , buffer
Rem     Send the buffer
        FtpXfrData.Send = buffer
Rem     We can't go into a tight loop sending data because FSSocket
Rem     may need some cpu cycles to actually send the data.
        DoEvents
Rem     Update our current possition in the file
        curpos = Seek(upload_file)
    Loop
Rem Close the connection
    FtpXfrData.Connect = False
    Close #upload_file
    upload_file = 0
    Exit Sub
delay:
Rem Was the error generated by FSSocket
    If Err = 20102 Then
Rem     Yes, was it "Operation would block"
        If FtpXfrData.WSALastError = 10035 Then
Rem         Yes, wait for the ready_to send event
            ready_to_send = False
            While ready_to_send = False
                DoEvents
            Wend
            Resume
        Else
Rem Some other error
            MsgBox FtpXfrData.WSALastErrorMsg
            Exit Sub
        End If
    Else
        MsgBox Error
        Exit Sub
    End If
    Resume
End Sub
Private Sub FtpXfrData_DataReceived (Text As String, EOL As Integer)
Rem A data block has arrived from the server, add it to the local file
    Put #download_file, , Text
End Sub
Private Sub FtpXfrData_Disconnected (StatusCode As Integer, Description As String)
Rem The data transfer has completed, close the port and the file.
    FtpXfrData.Listen = False
Rem If we are downloading a file, close it
    If download_file <> 0 Then
        Close #download_file
        download_file = 0
    End If
Rem Make sure the local file window is up to date.
    Local_File_List.Refresh
End Sub
Private Sub FtpXfrData_ReadyToSend ()
    ready_to_send = True
End Sub
Private Sub ListCurrentDirectory ()
Rem Clear the current Directory and File lists.
    Remote_Directory.Clear
    Remote_File_List.Clear
Rem Add a fake "parrent" directory entry.
    Remote_Directory.AddItem ".."
    If server_mode <> "a" Then
        Send_Command ("type a")
        server_mode = "a"
    End If
Rem Start listening for a connection from the server.
    OpenListPort

Rem Tell the server what port we are listening on.
    Send_Command ("port " & listport)
Rem Tell the server to list the current directory.
    Send_Command ("list")
End Sub
Private Sub ListRefreshButton_Click ()
Rem Rescan the current directory on the server
    ListCurrentDirectory
End Sub
Private Sub Local_Directory_Change ()
    Local_File_List.Path = Local_Directory.Path
    ChDir Local_Directory.Path
End Sub
Private Sub Local_Drive_Change ()
    Local_Directory.Path = Local_Drive.Drive    ' Set directory path.
    ChDrive Local_Drive.Drive
End Sub
Private Sub Local_File_List_DblClick ()
Rem Request for an upload
Rem Open a file to save the data into
    open_upload_file (Local_File_List.List(Local_File_List.ListIndex))
Rem Start listening for a connection from the server
    OpenXfrPort
    If client_mode <> server_mode Then
        Send_Command ("type " & client_mode)
        server_mode = client_mode
    End If
Rem Tell the server what port we are listening on.
    Send_Command ("port " & xfrport)
Rem Tell the sever we are sending a file.
    Send_Command ("stor " & Local_File_List.List(Local_File_List.ListIndex))
    If Left$(reply, 1) = "5" Then
            MsgBox reply
            FtpXfrData.Listen = False
            Exit Sub
        End If
Rem Refresh the remote directory list
    ListCurrentDirectory
End Sub
Private Sub Logout_Timer_Timer ()
Rem This timer will only fire if the server does not respond
Rem to a "quit" command in 5 seconds.
Rem Close all open connections
    ftpcommand.Connect = False
    FtpXfrData.Connect = False
    FtpDirData.Connect = False
Rem There may be a "send_command" call waiting for a response
Rem so lets give it one.
    reply = "221 Goodbye."
Rem Turn off the timer, we have disconnected.
    Logout_Timer.Interval = 0
End Sub
Private Sub open_download_file (filename As String)
Rem open a file to receive the data
    Dim Path As String
Rem If we are at the root, don't add an unneeded "\"
    If Right$(Local_Directory.Path, 1) = "\" Then
        Path = Local_Directory.Path & filename
    Else
        Path = Local_Directory.Path & "\" & filename
    End If
Rem Get a new file number
    download_file = FreeFile
Rem delete the receiving file if it exists
    On Error GoTo badpath
    Kill Path
    On Error GoTo 0
Rem Open the file.
Rem The file is binary because the sender will do the needed
Rem CR/LF translation if its an "ascii" file.
    Open Path For Binary Access Write As #download_file
    Exit Sub
badpath:
    If Err <> 53 Then
        MsgBox Error$ & Err
    End If
    Resume Next
End Sub
Private Sub open_upload_file (filename As String)
Rem open a file to receive the data
    Dim Path As String
Rem If we are at the root, don't add an unneeded "\"
    If Right$(Local_Directory.Path, 1) = "\" Then
        Path = Local_Directory.Path & filename
    Else
        Path = Local_Directory.Path & "\" & filename
    End If
Rem Get a new file number
    upload_file = FreeFile
Rem Open the file.
Rem The file is binary because the sender will do the needed
Rem CR/LF translation if its an "ascii" file.
    Open Path For Binary Access Read As #upload_file
End Sub
Private Sub OpenListPort ()
Dim i As Integer
Dim X As Integer
Dim address As String
Dim port As Integer
Rem Let TCP/IP select a port number.
    FtpDirData.ListenPort = 0
Rem Start listening.
    FtpDirData.Listen = True
Rem Save the portnumber that TCP/IP assigned.
    port = FtpDirData.ListenPort
Rem At this point we need to get our local address so that
Rem we can tell the server where to send the data.
Rem Unfortunatly the FipDirData.LocalAddress property may have
Rem an incorrect value at this point. The local IP address
Rem cannot be determined until a connection has been made.
Rem The system my have more than one IP address and TCP/IP
Rem does not know witch one to use.
Rem But we do have an open connection to the server for commands
Rem and we can use it's LocalAddress property because it is known
Rem to be good.
    address = ftpcommand.LocalAddress
Rem format the address and port for the ftp "port" command.
    For i = 1 To 3
        X = InStr(address, ".")
        If X <> 0 Then Mid$(address, X, 1) = ","
    Next i
    listport = address & "," & port \ 256 & "," & port Mod 256

End Sub
Private Sub OpenXfrPort ()
Dim i As Integer
Dim X As Integer
Dim address As String
Dim port As Integer
Rem Let TCP/IP select a port number.
    FtpXfrData.ListenPort = 0
Rem Start listening.
    FtpXfrData.Listen = True
Rem Save the portnumber that TCP/IP assigned.
    port = FtpXfrData.ListenPort
Rem At this point we need to get our local address so that
Rem we can tell the server where to send the data.
Rem Unfortunatly the FipDirData.LocalAddress property may have
Rem an incorrect value at this point. The local IP address
Rem cannot be determined until a connection has been made.
Rem The system my have more than one IP address and TCP/IP
Rem does not know witch one to use.
Rem But we do have an open connection to the server for commands
Rem and we can use it's LocalAddress property because it is known
Rem to be good.
    address = ftpcommand.LocalAddress
Rem format the address and port for the ftp "port" command.
    For i = 1 To 3
        X = InStr(address, ".")
        If X <> 0 Then Mid$(address, X, 1) = ","
    Next i
    xfrport = address & "," & port \ 256 & "," & port Mod 256
End Sub
Private Sub Remote_Current_Directory_Click ()
Rem An entry in the combo box has been selected.
    ChangeCurrentDirectory (Remote_Current_Directory.Text)
    ListCurrentDirectory
End Sub
Sub Remote_Current_Directory_KeyPress (KeyAscii As Integer)
Rem User typed in a directory.
    If KeyAscii = 13 Then
        ChangeCurrentDirectory (Remote_Current_Directory.Text)
        ListCurrentDirectory
    End If
End Sub
Private Sub Remote_Directory_DblClick ()
Rem Change the current directory on the server.
    ChangeCurrentDirectory (Remote_Directory.List(Remote_Directory.ListIndex))
Rem Get a new listing of the directory.
    ListCurrentDirectory
End Sub
Private Sub Remote_File_List_DblClick ()
Rem Request for a download
Rem Open a file to save the data into
    open_download_file (Remote_File_List.List(Remote_File_List.ListIndex))
    If client_mode <> server_mode Then
        Send_Command ("type " & client_mode)
        server_mode = client_mode
    End If
Rem Start listening for a connection from the server
    OpenXfrPort
Rem Tell the server what port we are listening on.
    Send_Command ("port " & xfrport)
Rem Tell the sever to transfer the file to us.
    Send_Command ("retr " & Remote_File_List.List(Remote_File_List.ListIndex))
End Sub
Private Sub Send_Command (command_line As String)
Rem Send a command to the server and wait for a response
    Static busy As Integer
    If busy Then
        Exit Sub
    End If
    If Not connected Then
        Exit Sub
    End If
    busy = True
    On Error GoTo errx:
Rem Change the pointer to an hourglass
    FtpDemo.MousePointer = 11
Rem Add the command to the commandwindow
    CommandWindow.SelStart = Len(CommandWindow.Text)
    CommandWindow.SelText = command_line & Chr$(13) & Chr$(10)
Rem Empty the reply string
    reply = ""
Rem Send the command.
    ftpcommand.Send = command_line & Chr$(10)
Rem Wait for a reply, ftpcommand.Data_received event will fill in the reply.
    While reply = ""
        DoEvents
    Wend
Rem Replies that begin with "1" are progress reports, ignore them
    While Mid$(reply, 1, 1) = "1"
        DoEvents
    Wend
Rem Some replies have a "-" in col 4, This means there is more to come
Rem so skip over them
    While Mid$(reply, 4, 1) = "-"
        DoEvents
    Wend
Rem We have a response, return the pointer to normal.
    FtpDemo.MousePointer = 0
    busy = False
    Exit Sub
errx:
    If Err = 20102 Then
        MsgBox ftpcommand.WSALastErrorMsg
    Else
        MsgBox Error
    End If
    Resume Next
End Sub