USO DE LA CLASE FTP

'-----
 Dim docs As New cFTP(FTP, portFTP)
 'Verificar credenciales
 docs.IdVerify(userFTP, passFTP)
 If docs.Connected Then
     If docs.DirList.Length > 0 Then
         listarFTP(FTP, DFTP, userFTP, passFTP)  'RUTINA ABAJO DETALLADA (Devuelve el contenido de la FTP en el ListView1)
         For i = 0 To ListView1.Items.Count - 1
         'Recogemos los nombres de todos los ficheros en el array ficheros
              ficheros(i) = ListView1.Items(j).Text 
         Next
      end if
 end if
'-----


'RUTINA QUE LISTA EL CONTENIDO DE SITIO FTP I LO EXPONE EN UN LISTVIEW
Sub listarFTP(ByRef adressFTP As String, ByVal directoryFTP As String, ByVal userFTP As String, ByVal passwFTP As String)

        Dim strList(250) As String
        Dim cSep() As Char = {vbCr, vbLf}
        Dim c As String, i As Integer
        Dim strItems() As String
        Dim oItem As ListViewItem
        '----
        If directoryFTP <> "" Then directoryFTP = "/" & directoryFTP
        Dim ftpWebReq As Net.FtpWebRequest = CType(Net.WebRequest.Create("ftp://" & adressFTP & directoryFTP), Net.FtpWebRequest)
        ftpWebReq.Credentials = New Net.NetworkCredential(userFTP, passwFTP)
        ftpWebReq.Method = Net.WebRequestMethods.Ftp.ListDirectoryDetails
        ftpWebReq.Proxy = Nothing
        Dim ftpWebResp As Net.FtpWebResponse = CType(ftpWebReq.GetResponse(), Net.FtpWebResponse)
        Dim streamer As IO.Stream = ftpWebResp.GetResponseStream()
        Dim reader As New IO.StreamReader(streamer)
        'Dim s As String = reader.ReadToEnd()
        Dim n As Integer = 0, linea As String


        While Not (reader.EndOfStream)
            linea = reader.ReadLine
            If InStr(linea, ".xml", CompareMethod.Text) Then 'En este caso solo busco ficheros XML
                strList(n) = linea
                n = n + 1
            End If
        End While


        Dim formato2 As Boolean
        For i = 0 To n - 1
            c = strList(i)
            If InStr(c, "group") <> 0 Then
                c = Trim(Mid(c, InStr(c, "group") + 5))
                formato2 = True
            End If


            If c.Length > 0 Then
                strItems = c.Split(" ")
                oItem = New ListViewItem()
                oItem.SubItems.Add("")
                oItem.SubItems.Add("")
                oItem.SubItems.Add("")
                oItem.SubItems.Add("")
                                        If InStr(c, ".xml") <> 0 Then  'En este caso solo busco ficheros XML
                    If formato2 Then '2 formatos posibles de como el sitio FTP no puede devolver la información de fichero
                        oItem.SubItems(1).Text = Trim(Mid(c, 1, InStr(c, " ") - 1)) 'Tamaño
                        c = Trim(Replace(c, oItem.SubItems(1).Text, ""))
                        oItem.SubItems(2).Text = Mid(c, 1, 6) 'Fecha
                        c = Trim(Replace(c, oItem.SubItems(2).Text, ""))
                        oItem.SubItems(3).Text = Mid(c, 1, 5) 'Hora
                        c = Trim(Replace(c, oItem.SubItems(3).Text, ""))
                        oItem.SubItems(0).Text = Trim(c) 'Fichero
                    Else 
                        oItem.SubItems(2).Text = Mid(c, 1, 8) 'Fecha
                        c = Trim(Replace(c, oItem.SubItems(2).Text, ""))
                        oItem.SubItems(3).Text = Mid(c, 1, 7) 'Hora
                        c = Trim(Replace(c, oItem.SubItems(3).Text, ""))
                        oItem.SubItems(1).Text = Trim(Mid(c, 1, InStr(c, " ") - 1)) 'Tamaño
                        c = Trim(Replace(c, oItem.SubItems(1).Text, ""))
                        oItem.SubItems(0).Text = extraerNOMFICHERO(c) 'Fichero
                    End If
                    
                    If oItem.SubItems(1).Text.Length = 0 Then oItem.SubItems(1).Text = "





"
                    If oItem.SubItems(1).Text = "
" Then
                        oItem.ImageIndex = 0
                    Else
                        oItem.ImageIndex = 1
                    End If
                    ListView1.Items.Add(oItem)
                    oItem = Nothing
                End If
            End If
        Next
End Sub
Function extraerNOMFICHERO(ByVal c As String) As String
'Recursiva que nos devuelve el nombre del fichero'En el formato 2 está al final de la cadena   If InStr(Trim(c), " ") > 0 Then
      c = Trim(Mid(c, InStr(c, " ") + 1))
      c = extraerNOMFICHERO(c)
   End If
   Return c
End Function

CLASE FTP (GESTIÓN SITES FTP)

'Classe para gestionar FTP


Imports System.Net
Imports System.Net.Sockets
Imports System.IO
Imports System.Text
Imports Microsoft.VisualBasic
Imports System.Runtime.Remoting.Messaging


Public Class cFTP


    Private mTCPClient As New TcpClient()
    Private mNetStream As NetworkStream
    Private mBytes() As Byte
    Private intBytesRec As Int64
    Private mDataStream As NetworkStream
    Private mTCPData As New TcpClient()
    Private mServerAddr As IPAddress
    Private mFTPPort As Int32 = 21
    Private mConnected As Boolean = False
    Private mFTPResponse As String
    Public Event ServerReplied(ByVal ServerReply As String)
    Public Event ServerCalled(ByVal CallMsg As String)
    Public Event ErrorOccured(ByVal ErrorCode As Integer, ByVal ErrMessage As String)
    Public Event Transferring(ByVal intTransferred As Integer, ByVal intTotalFile As Integer)


    Public Enum EC As Integer
        NoError = 0
        BuildConnectionFailed = 1
        ConnectionClosingFailed = 2
        DirListFailed = 3
        ProttectedChannelFailed = 4
        DownloadFailed = 5
        UploadFailed = 6
        FTPCommandFailed = 7
        FTPGetFileFailed = 8
        FTPPutFileFailed = 9
        InvalidEntry = 30
        ServerImproper = 31
        ServerRejectedUser = 32
        ServerRejectedPass = 33
        ServerDeniedDirList = 34
        InvalidFileLength = 35
        DownUpLoadFailure = 36
        UnknownError = 9999
    End Enum


    'IP DEL SERVIDOR FTP 
    ReadOnly Property ServerAddress() As IPAddress
        Get
            ServerAddress = mServerAddr
        End Get
    End Property


    'PUERTO FTP 
    ReadOnly Property FTPPort() As Int32
        Get
            FTPPort = mFTPPort
        End Get
    End Property


    'ESTADO DE LA CONEXIÓN
    ReadOnly Property Connected() As Boolean
        Get
            Connected = mConnected
        End Get
    End Property


    'INFO DEL SERVIDOR FTP
    ReadOnly Property FTPResponse() As String
        Get
            FTPResponse = mFTPResponse
            mFTPResponse = ""
        End Get
    End Property


    'CONTRUCTORES
    Public Sub New(ByVal ServerAddr As IPAddress, ByVal FtpPort As Int32)
        BuildConnection(ServerAddr, FtpPort)
    End Sub


    Public Sub New(ByVal ServerAddr As String, ByVal FtpPort As Int32)
        Try
            BuildConnection(Dns.Resolve(ServerAddr).AddressList(0), FtpPort)
        Catch err As Exception
            MessageBox.Show("No se puede realizar la conexión." & vbCrLf & "Revise que tiene acceso a la red y/o" & vbCrLf & "que los parámetros de la conexión (Herramientas/Configuración ...) sean correctos", "TGV Central", MessageBoxButtons.OK, MessageBoxIcon.Error)
            MsgBox(err.ToString())
            Me.Dispose()
        End Try
    End Sub


    Public Delegate Sub DnsCallback(ByVal ar As IAsyncResult)


    'DESTRUCTOR
    Protected Sub Dispose()
        If Not mConnected Then
            Call Close()
        End If
    End Sub


    'CONNEXIóN FTP
    Private Sub BuildConnection(ByVal ServerAddr As IPAddress, ByVal FtpPort As Int32)
        Dim strTemp As String


        If FtpPort <= 0 Or FtpPort > 65535 Then
            RaiseEvent ErrorOccured(EC.InvalidEntry, "Port number must be between 1 and 65535!")
            Exit Sub
        End If
        
        mServerAddr = ServerAddr
        mFTPPort = FtpPort
        
        Try
            mTCPClient.Connect(ServerAddr, FtpPort)
            mNetStream = mTCPClient.GetStream()
            strTemp = GetResponse()
            If strTemp.Substring(0, 4) <> "220 " Then
                If strTemp.Substring(0, 3) = "220" Then
                    GetResponse()
                Else
                    RaiseEvent ErrorOccured(EC.ServerImproper, "Serever replied improperly during connection!")
                End If
            End If
            mConnected = True
        Catch err As Exception
            RaiseEvent ErrorOccured(EC.BuildConnectionFailed, err.ToString())
        End Try
    End Sub
   
    Public Sub Close()
        If mConnected Then
            Erase mBytes
            Try
                mBytes = Encoding.ASCII.GetBytes("QUIT" & vbCrLf)
                mNetStream.Write(mBytes, 0, mBytes.Length)
                Call GetResponse()
                mTCPClient.Close()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.ConnectionClosingFailed, err.ToString())
            Finally
                mConnected = False
            End Try
        End If
    End Sub


    'RESPUESTA DEL SERVIDOR
    Private Function GetResponse() As String
        Dim strTemp As String


        Do
            ReDim mBytes(mTCPClient.ReceiveBufferSize)
            intBytesRec = mNetStream.Read(mBytes, 0, CInt(mTCPClient.ReceiveBufferSize))
            strTemp = strTemp & Encoding.ASCII.GetString(mBytes, 0, intBytesRec)
        Loop While mNetStream.DataAvailable
        If strTemp.Length > 0 Then
            RaiseEvent ServerReplied(strTemp)
        End If
        mFTPResponse = mFTPResponse & strTemp
        GetResponse = strTemp
    End Function


    'LOGEARSE
    Public Sub IdVerify(ByVal strID As String, ByVal strPW As String)
        Dim strTemp As String


        If mConnected Then
            'ID
            If strID.Length = 0 Then
                strID = "anonymous"
            End If
            strTemp = "USER " & strID & vbCrLf
            RaiseEvent ServerCalled(strTemp)
            mBytes = Encoding.ASCII.GetBytes(strTemp)
            mNetStream.Write(mBytes, 0, mBytes.Length)
            strTemp = GetResponse()
            If strTemp.Substring(0, 4) <> "331 " Then
                RaiseEvent ErrorOccured(EC.ServerRejectedUser, "Server rejected user " & strID & "!")
                Exit Sub
            End If
            'password
            strTemp = "PASS " & strPW & vbCrLf
            RaiseEvent ServerCalled(strTemp)
            mBytes = Encoding.ASCII.GetBytes(strTemp)
            mNetStream.Write(mBytes, 0, mBytes.Length)
            strTemp = GetResponse()
            If strTemp.Substring(0, 4) <> "230 " Then
                RaiseEvent ErrorOccured(EC.ServerRejectedPass, "Incorrect password! Server rejected password...")
                Exit Sub
            End If
            Application.DoEvents()
            If mNetStream.DataAvailable Then
                Call GetResponse()
            End If
        End If
    End Sub


    'LISTAR DIRECTORIO FTP
    Public Function DirList(Optional ByVal cDirectory As String = "..") As String
        Dim priSM As New MemoryStream()
        Dim strTemp As String
        Dim intport As Int32


        If mConnected Then
            Try
                intPort = cmdPasv2Port()
                If cDirectory = ".." Then
                    strTemp = "LIST -aL" & vbCrLf
                Else
                    strTemp = "LIST " & cDirectory & vbCrLf
                End If
                RaiseEvent ServerCalled(strTemp)
                mBytes = Encoding.ASCII.GetBytes(strTemp)
                mNetStream.Write(mBytes, 0, mBytes.Length)
                strTemp = GetResponse()
                priSM = GetInfo(intPort)
                DirList = Encoding.ASCII.GetString(priSM.ToArray, 0, priSM.Length)


                strTemp = GetResponse()
                If strTemp.Substring(0, 4) <> "150 " Then
                    RaiseEvent ErrorOccured(EC.ServerDeniedDirList, "Server denied DirListCommand!")
                End If
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.DirListFailed, err.ToString())
            End Try
        End If
    End Function


   
    Public Function cmdPasv2Port() As Int32
        Dim i, j As Int32
        Dim strTemp As String


        If mConnected Then
            
            Erase mBytes
            strTemp = "PASV" & vbCrLf
            RaiseEvent ServerCalled(strTemp)
            mBytes = Encoding.ASCII.GetBytes(strTemp)
            Try
                mNetStream.Write(mBytes, 0, mBytes.Length)
                strTemp = GetResponse()
                If strTemp.Substring(0, 4) <> "227 " Then
                    Call GetResponse()
                End If


                strTemp = mFTPResponse
                i = strTemp.LastIndexOf(",")
                j = strTemp.LastIndexOf(")")
                cmdPasv2Port = CInt(strTemp.Substring(i + 1, j - i - 1))
                strTemp = strTemp.Substring(1, i - 1)
                j = i
                i = strTemp.LastIndexOf(",")
                cmdPasv2Port = 256 * CInt(strTemp.Substring(i + 1, j - i - 2)) + cmdPasv2Port
                mTCPData = New TcpClient(mServerAddr.ToString, cmdPasv2Port)
                mTCPData.ReceiveBufferSize = 16384
                mDataStream = mTCPData.GetStream()
            Catch err As Exception
                MsgBox(err.Message, , "BibI")
                                RaiseEvent ErrorOccured(EC.ProttectedChannelFailed, err.ToString())
            End Try
        End If
    End Function
   
    Private Function OtherPortGet(ByVal intDataPort As Int32, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
        Dim strTemp As String
        Dim i As Int64
        Dim priSM As New MemoryStream()


        If BytesWillRec >= 0 Then
            Try
                ReDim mBytes(mTCPData.ReceiveBufferSize)
                intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                priSM.Write(mBytes, 0, intBytesRec)
                i = intBytesRec
                RaiseEvent Transferring(i, BytesWillRec)
                If BytesWillRec = 0 Then
                    Do While mDataStream.DataAvailable
                        ReDim mBytes(mTCPData.ReceiveBufferSize)
                        intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                        priSM.Write(mBytes, 0, intBytesRec)
                        i = i + intBytesRec
                        RaiseEvent Transferring(i, BytesWillRec)
                        Beep()
                        Application.DoEvents()
                    Loop
                Else
                    Do While i < BytesWillRec
                        ReDim mBytes(mTCPData.ReceiveBufferSize)
                        intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                        priSM.Write(mBytes, 0, intBytesRec)
                        i = i + intBytesRec
                        RaiseEvent Transferring(i, BytesWillRec)
                    Loop
                End If


                OtherPortGet = priSM
                mTCPData.Close()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.DownloadFailed, err.ToString())
            End Try
        Else
            RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid file length!")
        End If
    End Function
  
    Private Function OtherPortPut1(ByVal intDataPort As Int32, ByVal strFN As String, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
        Dim strTemp As String
        Dim i As Int64
        Dim priSM As New MemoryStream()
        Dim priSM1 As FileStream
        Dim intTmp As Integer


        If BytesWillRec >= 0 Then
            Try
                ReDim mBytes(FileLen(strFN))


                priSM1 = File.OpenRead(strFN)
                intBytesRec = priSM1.Read(mBytes, 0, FileLen(strFN))
                intTmp = 16384
                Do While i < mBytes.Length
                    If mBytes.Length - i < 16384 Then
                        intTmp = mBytes.Length - i
                    End If
                    priSM.Write(mBytes, i, intTmp)
                    priSM.WriteTo(mDataStream)
                    i += intTmp
                    Application.DoEvents()
                Loop




                mDataStream.Close()
                OtherPortPut1 = priSM
                mTCPData.Close()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.UploadFailed, err.ToString())
            End Try
        Else
            RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid declared file length!")
        End If
    End Function


    Private Function OtherPortPut(ByVal intDataPort As Int32, ByVal strFN As String, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
        Dim strTemp As String
        Dim i As Int64
        Dim priSM As New MemoryStream()
        Dim priSM1 As FileStream
        Dim intTmp As Integer


        If BytesWillRec >= 0 Then
            Try
                ReDim mBytes(FileLen(strFN))


                priSM1 = File.OpenRead(strFN)
                intBytesRec = priSM1.Read(mBytes, 0, FileLen(strFN))
                priSM.Write(mBytes, 0, mBytes.Length - 1)
                priSM.WriteTo(mDataStream)




                mDataStream.Close()
                OtherPortPut = priSM
                mTCPData.Close()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.UploadFailed, err.ToString())
            End Try
        Else
            RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid declared file length!")
        End If
    End Function


    ' Sends general command to server
    Public Function FtpCommand(ByVal strCommand As String) As String
        If mConnected Then
            Try
                Erase mBytes
                RaiseEvent ServerCalled(strCommand & vbCrLf)
                mBytes = Encoding.ASCII.GetBytes(strCommand & vbCrLf)
                mNetStream.Write(mBytes, 0, mBytes.Length)
                FtpCommand = GetResponse()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.FTPCommandFailed, err.ToString())
            End Try
        End If
    End Function


    'FTP DESCARGAR FICHEROS
    Public Function FtpGetFile(ByVal strFile As String, ByVal strDest As String, ByVal intSize As Long) As MemoryStream
        Dim priSM As New MemoryStream()
        Dim strTemp As String
        Dim i, j As Int16
        Dim intPort As Int32
        Dim sw As FileStream
        Dim b() As Byte


        If mConnected Then
            Try
                FtpCommand("TYPE I")
                intPort = cmdPasv2Port()
                FtpCommand("RETR " & strFile)


                priSM = OtherPortGet(intPort, intSize)
                b = priSM.ToArray()
                sw = File.OpenWrite(strDest)
                sw.Write(b, 0, b.Length)
                sw.Close()
                FtpGetFile = priSM


                strTemp = GetResponse()
                If strTemp.Substring(0, 4) <> "226 " Then
                    RaiseEvent ErrorOccured(EC.DownUpLoadFailure, "Transfer failure!")
                End If
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.FTPGetFileFailed, err.ToString())
            End Try
        End If
    End Function


    ' FTP SUBIR FICHEROS
    Public Function FtpPutFile(ByVal strFile As String, ByVal strDest As String, ByVal intSize As Long) As MemoryStream
        Dim priSM As New MemoryStream()
        Dim strTemp As String
        Dim i, j As Int16
        Dim intPort As Int32


        If mConnected Then
            Try
                strTemp = FtpCommand("TYPE I")
               


                intPort = cmdPasv2Port()
                strTemp = FtpCommand("STOR " & strDest)




                i = mFTPResponse.LastIndexOf(")", mFTPResponse.Length - 1)
                j = mFTPResponse.LastIndexOf("(", i)
                i = mFTPResponse.IndexOf(" ", j)
                strTemp = mFTPResponse.Substring(j + 1, i - j - 1)


                priSM = OtherPortPut(intPort, strFile, intSize)




                FtpPutFile = priSM


                strTemp = GetResponse()




                If strTemp.Substring(0, 4) <> "226 " Then
                    RaiseEvent ErrorOccured(EC.DownUpLoadFailure, "Falló la transferencia!")
                End If
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.FTPPutFileFailed, err.ToString())
            End Try
        End If
    End Function


    Public Function FileDet(ByVal strFN As String) As String
        Dim priSM As New MemoryStream()
        Dim strTemp As String
        Dim intPort As Int32


        If mConnected Then
            Try
                intPort = cmdPasv2Port()
                strTemp = "LIST " & strFN & vbCrLf
                RaiseEvent ServerCalled(strTemp)
                mBytes = Encoding.ASCII.GetBytes(strTemp)
                mNetStream.Write(mBytes, 0, mBytes.Length)
                priSM = GetInfo(intPort)
                FileDet = Encoding.ASCII.GetString(priSM.ToArray, 0, priSM.Length)


                strTemp = GetResponse()
                If strTemp.Substring(0, 4) <> "150 " Then
                    RaiseEvent ErrorOccured(EC.ServerDeniedDirList, "Server denied DirListCommand!")
                End If
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.DirListFailed, err.ToString())
            End Try
        End If
    End Function


    Private Function GetInfo(ByVal intDataPort As Int32, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
        Dim strTemp As String
        Dim i As Int64
        Dim priSM As New MemoryStream()


        If BytesWillRec >= 0 Then
            Try
                ReDim mBytes(mTCPData.ReceiveBufferSize)
                intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                priSM.Write(mBytes, 0, intBytesRec)
                i = intBytesRec
                If BytesWillRec = 0 Then
                    Do While mDataStream.DataAvailable
                        ReDim mBytes(mTCPData.ReceiveBufferSize)
                        intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                        priSM.Write(mBytes, 0, intBytesRec)
                        i = i + intBytesRec
                        Beep()
                        Application.DoEvents()
                    Loop
                Else
                    Do While i < BytesWillRec
                        ReDim mBytes(mTCPData.ReceiveBufferSize)
                        intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
                        priSM.Write(mBytes, 0, intBytesRec)
                        i = i + intBytesRec
                    Loop
                End If


                GetInfo = priSM
                mTCPData.Close()
            Catch err As Exception
                RaiseEvent ErrorOccured(EC.DownloadFailed, err.ToString())
            End Try
        Else
            RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid file length!")
        End If
    End Function


    Public Function FolderOp(ByVal cName As String, Optional ByVal bCreate As Boolean = True) As Boolean
        If bCreate Then
            FolderOp = (FtpCommand("MKD " & cName).Substring(0, 4) = "257 ")
        Else
            FolderOp = (FtpCommand("RMD " & cName).Substring(0, 4) = "250 ")
        End If
    End Function


    Public Function RenameFile(ByVal cOldName As String, ByVal cNewName As String) As Boolean
        Dim b As Boolean


        b = (FtpCommand("RNFR " & cOldName).Substring(0, 4) = "350 ")
        b = b And (FtpCommand("RNTO " & cNewName).Substring(0, 4) = "250 ")
        RenameFile = b
    End Function


    Public Function DeleteFile(ByVal cFileName As String) As Boolean
        DeleteFile = (FtpCommand("DELE " & cFileName).Substring(0, 4) = "250 ")
    End Function


  End Class