Option Explicit
 
Private Type Datos
    Respuesta As String
    Comando As String
End Type
 
Dim Comandos(5) As Datos
Dim Estado As Integer
Dim Sitio As String, Usuario As String, Password As String, ArchivoRemoto As String, ArchivoLocal As String
Dim TamañoBuffer As Long
Dim EstaCerrado As Boolean
 
Private Sub Command1_Click()
 
Sitio = "ftp.tuservidor.com.ar"
Usuario = "tuusuario"
Password = "tucontraseña"
ArchivoLocal = "c:\a.txt"
ArchivoRemoto = "/carpetadetuservidor/a.txt"
Comandos(0).Respuesta = "220"
Comandos(0).Comando = "USER " + Usuario
Comandos(1).Respuesta = "331"
Comandos(1).Comando = "PASS " + Password
Comandos(2).Respuesta = "230"
Comandos(2).Comando = "TYPE I"
Comandos(3).Respuesta = "200"
Comandos(3).Comando = "PORT"
Comandos(4).Respuesta = "200"
Comandos(4).Comando = "STOR " + ArchivoRemoto
Comandos(5).Respuesta = ""
Comandos(5).Comando = ""
TamañoBuffer = 2920
 
Dim Nr1 As Integer
Dim Nr2 As Integer
Dim IPLocal As String
 
IPLocal = Winsock1.LocalIP
 
Do Until InStr(IPLocal, ".") = 0
    IPLocal = Left(IPLocal, InStr(IPLocal, ".") - 1) + "," + Right(IPLocal, Len(IPLocal) - InStr(IPLocal, "."))
Loop
 
Randomize Timer
 
Nr1 = Int(Rnd * 12) + 5
Nr2 = Int(Rnd * 254) + 1
Comandos(3).Comando = "PORT " + IPLocal + "," + Trim(Str(Nr1)) + "," + Trim(Str(Nr2))
Winsock2.Close
 
Do Until Winsock2.State = 0
    DoEvents
Loop
 
Winsock2.LocalPort = (Nr1 * 256) + Nr2
Winsock2.Listen
Winsock1.Close
 
Do Until Winsock1.State = 0
    DoEvents
Loop
 
Winsock1.RemoteHost = Sitio
Winsock1.RemotePort = 21
Winsock1.Connect
Estado = 0
 
Do Until Winsock1.State = 7 Or Winsock1.State = 9
    DoEvents
Loop
 
Select Case Winsock1.State
    Case 9
    MsgBox "No se pudo Conectar al Servidor " + Sitio + ".", vbOKOnly + vbInformation
    Case 7
    Open ArchivoLocal For Binary As #1
End Select
 
End Sub
 
 
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
 
Dim tmpS As String
Winsock1.GetData tmpS, , bytesTotal
Debug.Print tmpS;
 
Select Case Left(tmpS, 3)
    Case Comandos(Estado).Respuesta
        Winsock1.SendData Comandos(Estado).Comando + Chr(13) + Chr(10)
        Debug.Print Comandos(Estado).Comando
        Estado = Estado + 1
    Case "150"
        Do Until Winsock2.State = 7
            DoEvents
        Loop
        Call EnviarDatos
    Case "226"
        Winsock1.Close
        Do Until Winsock1.State = 0
            DoEvents
        Loop
        MsgBox "Subida de Archivo Completa....", vbOKOnly + vbInformation
    Case Else
        MsgBox "No Hay Respuesta del Servidor: " + Left(tmpS, Len(tmpS) - 2), vbOKOnly + vbInformation
End Select
 
End Sub
 
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close
Do Until Winsock2.State = 0
    DoEvents
Loop
Winsock2.Accept requestID
Do Until Winsock2.State = 7
    DoEvents
Loop
End Sub
 
Sub EnviarDatos()
Dim Take As Long
Dim Buffer As String
If LOF(1) - Seek(1) < TamañoBuffer Then Take = LOF(1) - Seek(1) + 1 Else Take = TamañoBuffer
Buffer = Input(Take, 1)
Winsock2.SendData Buffer
 
If Take < TamañoBuffer Then
    Close #1
    EstaCerrado = True
End If
End Sub
 
 
Private Sub Winsock2_SendComplete()
If EstaCerrado = True Then
    Winsock2.Close
Do Until Winsock2.State = 0
    DoEvents
Loop
    EstaCerrado = False
Else
    EnviarDatos
End If
End Sub