'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
No hay comentarios:
Publicar un comentario