Soluciones vb.net: 2010

INICIAR UN PROCESO CON PROCESS.START

System.Diagnostics.Process.Start("http://solucionesvbnet.blogspot.com")

http://msdn.microsoft.com/es-es/library/system.diagnostics.process.start(v=vs.80).aspx

DETECTAR IMPRESORAS

Imports System.Drawing.Printing

Dim Impresoras As String

'recorre las impresoras instaladas y añade el name a un combo

For Each Impresoras In PrinterSettings.InstalledPrinters

cmbImp.Items.Add(Impresoras.ToString)

CONVERTIR IMAGE A STRING / STRING A IMAGE

Public Function imageToByteArray(ByVal imageIn As System.Drawing.Image, ByVal pformato As System.Drawing.Imaging.ImageFormat) As Byte()

Dim ms As New IO.MemoryStream
Try
imageIn.Save(ms, pformato)
Catch ex As Exception
End Try
Return ms.ToArray()

End Function

Public Function byteArrayToImage(ByVal byteArrayIn As Byte()) As Image
Dim returnImage As Image = Nothing
Try
Dim ms As New IO.MemoryStream(byteArrayIn)
returnImage = Image.FromStream(ms)
Catch ex As Exception
End Try
Return returnImage

End Function

Private Function ArrayToString(ByVal bytes() As Byte, Optional ByVal format As String = Nothing) As String
   If bytes.Length = 0 Then Return String.Empty
   Dim sb As New System.Text.StringBuilder(bytes.Length * 4)
   For Each b As Byte In bytes
   sb.Append(b.ToString(format))
   sb.Append(","c)
   Next
   sb.Length -= 1
   Return sb.ToString()
   End Function

   Private Function StringToArray(ByVal s As String, Optional ByVal style As System.Globalization.NumberStyles = Nothing) As Byte()
   If s.Length = 0 Then Return New Byte() {}
   Dim values() As String = s.Split(","c)
   Dim bytes(values.Length - 1) As Byte
   For index As Integer = 0 To values.Length - 1
   bytes(index) = Byte.Parse(values(index), style)
   Next
   Return bytes
   End Function

'Ejemplo Imagen a String-->
dim strImage as string=""

strImage = ArrayToString(imageToByteArray(My.Resources.miImagen, System.Drawing.Imaging.ImageFormat.Png), Nothing)

FORMULARIO COLOR DEGRADADO

   Public Sub paintForm(ByVal e As System.Windows.Forms.PaintEventArgs, ByVal direccionGradiente As String, ByVal color1 As Color, ByVal color2 As Color, ByVal frm As Form)
   Dim y As Integer = 0
   Dim x As Integer = 0
   Dim ancho As Integer = frm.Width
   Dim alto As Integer = frm.Height
   Dim Y_ As Integer = 0, X_ As Integer = 0
   Dim _Y As Integer = 0, _X As Integer = 0

   Try

   Select Case UCase(direccionGradiente)
   Case "TOP-BOTTOM"
   _Y = y + alto
   _X = x
   Y_ = y
   X_ = x
   Case "LEFT-RIGHT"
   _Y = y
   _X = x + ancho
   Y_ = y
   X_ = x
   Case "BOTTOM-TOP"
   _Y = y
   _X = x
   Y_ = y + alto
   X_ = x
   Case "RIGHT-LEFT"
   _Y = y
   _X = x
   Y_ = y
   X_ = x + alto
   Case Else
   _Y = y
   _X = x
   Y_ = y + alto
   X_ = x

   End Select

   Dim colorear As New LinearGradientBrush(New Point(X_, Y_), New Point(_X, _Y), color1, color2)

   e.Graphics.FillRectangle(colorear, x, y, ancho, alto)

   Catch ex As Exception

   End Try
   End Sub

   'Degradar desde el centro del form
   Public Sub paintForm2(ByVal e As System.Windows.Forms.PaintEventArgs, ByVal color1 As Color, ByVal color2 As Color, ByVal frm As Form)

   Dim y As Integer = 0
   Dim x As Integer = 0
   Dim ancho As Integer = frm.Width
   Dim alto As Integer = frm.Height
   Dim _Y As Integer = 0, _X As Integer = 0

   Try
   _Y = y + alto
   _X = x

   Dim colorear As New LinearGradientBrush(New Point(0, 0), New Point(0, _Y / 2), color1, color2)
   Dim colorear2 As New LinearGradientBrush(New Point(0, _Y / 2 - 1), New Point(0, _Y), color2, color1)

   Dim MED As Integer = alto / 2

   e.Graphics.FillRectangle(colorear, x, y, ancho, MED)
   e.Graphics.FillRectangle(colorear2, x, MED, ancho, MED)
   Catch ex As Exception

   End Try
   End Sub

DETECTAR SI UN PUERTO ESTÁ ABIERTO

Imports System.Net.Sockets

Public Function IsPortOpen(ByVal Host As String, ByVal Port As Integer) As Boolean
   Dim m_sck As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
   Try
   m_sck.Connect(Host, Port)
   Return True
   Catch ex As SocketException
   'Código para manejar error del socket (cerrado, conexión rechazada)
   Catch ex As Exception
   'Código para manejar otra excepción
   End Try
   Return False
End Function

http://www.elguille.info/colabora/2007/thepirat_HilosYpuertos.htm

RELLENAR FORMULARIO PDF (C#) CON itextsharp.dll

http://itextpdf.com/

'relCAMPOSxVALOR = nombrecampo&valorcampo|nombrecampo2&valorcampo2|...
public void writePDF(string relCAMPOSxVALOR, string PDForigen, string PDFfin)
   {
   string pdfTemplate = @PDForigen;
   string newFile = @PDFfin;
   string fileREL = @relCAMPOSxVALOR;

   try
   {
   System.IO.StreamReader sw = new System.IO.StreamReader(fileREL, Encoding.Default);
   relCAMPOSxVALOR = sw.ReadToEnd();
   sw.Close();
   System.IO.File.Delete(fileREL);
   }
   catch
   {
   }

   PdfReader pdfReader = new PdfReader(pdfTemplate);
   PdfStamper pdfStamper = new PdfStamper(pdfReader, new FileStream(
   newFile, FileMode.Create));

   AcroFields pdfFormFields = pdfStamper.AcroFields;

   try
   {

   string CAMPO;
   string VALOR;

   relCAMPOSxVALOR = relCAMPOSxVALOR.Replace("\r\n", "");

   CAMPO = relCAMPOSxVALOR.Substring(0, relCAMPOSxVALOR.IndexOf("&", 1));
   relCAMPOSxVALOR = relCAMPOSxVALOR.Substring(relCAMPOSxVALOR.IndexOf("&", 1) + 1);
   VALOR = relCAMPOSxVALOR.Substring(0, relCAMPOSxVALOR.IndexOf("|", 1));
   relCAMPOSxVALOR = relCAMPOSxVALOR.Substring(relCAMPOSxVALOR.IndexOf("|", 1) + 1);

   pdfFormFields.SetField(CAMPO, VALOR);

   if (relCAMPOSxVALOR.Length != 0)
   {
   writePDF_sub(relCAMPOSxVALOR, PDForigen, PDFfin, pdfStamper.AcroFields);
   }
   }
   catch (InvalidCastException e)
   {
   throw (e); // Rethrowing exception e
   }

   // flatten the form to remove editting options, set it to false
   // to leave the form open to subsequent manual edits
   pdfStamper.FormFlattening = false;

   // close the pdf
   pdfStamper.Close();
   }

   private void writePDF_sub(string relCAMPOSxVALOR, string PDForigen, string PDFfin, AcroFields pdfFormFields)
   {
   string pdfTemplate = @PDForigen;
   string newFile = @PDFfin;

   try
   {
   string CAMPO;
   string VALOR;

   if (relCAMPOSxVALOR.IndexOf("&") > 0 && relCAMPOSxVALOR.IndexOf("|") > 0)
   {
   CAMPO = relCAMPOSxVALOR.Substring(0, relCAMPOSxVALOR.IndexOf("&", 1));
   relCAMPOSxVALOR = relCAMPOSxVALOR.Substring(relCAMPOSxVALOR.IndexOf("&", 1) + 1);
   VALOR = relCAMPOSxVALOR.Substring(0, relCAMPOSxVALOR.IndexOf("|", 1));
   relCAMPOSxVALOR = relCAMPOSxVALOR.Substring(relCAMPOSxVALOR.IndexOf("|", 1) + 1);

   pdfFormFields.SetField(CAMPO, VALOR);

   if (relCAMPOSxVALOR.Length != 0)
   {
   writePDF_sub(relCAMPOSxVALOR, PDForigen, PDFfin, pdfFormFields);
   }
   }
   }
   catch (InvalidCastException e)
   {
   throw (e); // Rethrowing exception e
   }

   }

WinScp (Ejemplos de uso de la herramienta)

http://winscp.net

'Sincronizar directorio FTP con directorio local

Dim Linea As String = " /command " & Chr(34) & "option batch on" & Chr(34) & " " & Chr(34) & "option confirm off" & Chr(34) & " " & Chr(34) & "reconnecttime 10" & Chr(34) & " " & Chr(34) & "open ftp://" & FTPuser & ":" & FTPpwd & "@" & FTP & Chr(34) & " " & Chr(34) & "synchronize both " & Chr(34) & Chr(34) & LOCALfolder & Chr(34) & Chr(34) & " " & FTPfolder & Chr(34)

Dim exe As New Process
exe.StartInfo = New ProcessStartInfo("winscp.exe", Linea)
exe.Start()

'Envío varíos archivos creando directorio en el sitio FTP
Dim T As String = ""
Dim Linea As String = ""

If Trim(RUTAARCHIVO1) <> "" Then T = T & " " & Chr(34) & "put " & Chr(34) & Chr(34) & RUTAARCHIVO1 & Chr(34)
If Trim(RUTAARCHIVO2) <> "" Then T = T & " " & Chr(34) & "put " & Chr(34) & Chr(34) & RUTAARCHIVO2 & Chr(34)
If Trim(RUTAARCHIVO3) <> "" Then T = T & " " & Chr(34) & "put " & Chr(34) & Chr(34) & RUTAARCHIVO3 & Chr(34)
If Trim(RUTAARCHIVO4) <> "" Then T = T & " " & Chr(34) & "put " & Chr(34) & Chr(34) & RUTAARCHIVO4 & Chr(34)

Linea = " /console /command " & Chr(34) & "option batch on" & Chr(34) & " " & Chr(34) & "option confirm off" & Chr(34) & " " & Chr(34) & "open ftp://" & FTPuser & ":" & FTPpwd & "@" & FTP & Chr(34) & " " & Chr(34) & "mkdir " & FTPdirectorio & " " & Chr(34) & "cd " & FTPdirectorio & Chr(34) & " " & Chr(34) & T & " " & Chr(34) & " exit" & Chr(34) & Chr(34) & Chr(34)

Dim exe As New Process
exe.StartInfo = New ProcessStartInfo("winscp.exe", Linea)
exe.Start()

SUBPROCESOS INDEPENDIENTES (BackgroundWorker)

Private WithEvents TestWorker As System.ComponentModel.BackgroundWorker

   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
   'llamada al subproceso al hacer desde el proceso principal en el evento clic del botón
   TestWorker = New System.ComponentModel.BackgroundWorker
   TestWorker.WorkerReportsProgress = True
   TestWorker.WorkerSupportsCancellation = True
   TestWorker.RunWorkerAsync()
   End Sub

Private Sub TestWorker_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles TestWorker.DoWork
   Dim ListText As String
   'Acción a realizar en el subproceso
   For Value As Integer = 0 To 100
   If TestWorker.CancellationPending Then
   Exit For
   End If
   ListText = String.Concat("Item #", Value)
   TestWorker.ReportProgress(Value, ListText)
   'Retrasamos el hilo de ejecución
   Threading.Thread.Sleep(100)
   Next
   End Sub

Private Sub TestWorker_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles TestWorker.RunWorkerCompleted
   MsgBox("Fin de la ejecución del subproceso")
   End Sub

http://msdn.microsoft.com/es-es/library/system.componentmodel.backgroundworker(VS.95).aspx

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