Enviar archivo a FTP

[LeXteR]

hola de nuevo a todos, vereis, tengo un code para mandar un archivo a un servidor ftp, de ftp.webcindario.com, para ser exactos.
Pues bien, en esto codigo utilizo las Api de windows y va de maravilla, pero por curiosidad mayormente ¿teneis otro codigo para mandarlo de forma distinta?? con un winsock o con telnet... me gustaria ver el codigo, para aprender mas tambien...

muchas gracias

[zabait]

Yo también quiero aprender...

Si publicas el código que dices por API, publico el mio.

Yo utilizo INET Control, pero con llamadas a funciones del API ya que sino me daba un error muy raro.

Tú mismo

[LeXteR]

aqui esta el codigo, no hace falta poner ningun control inet, ni winsock ni nada:

Código:

'Declaraciones
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const PassiveConnection As Boolean = True
Const INTERNET_FLAG_PASSIVE = &H8000000
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0

Dim hConnection, hOpen, Num As Long

'Subir el archivo a un ftp

hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
DoEvents
hConnection = InternetConnect(hOpen, "ftp.webcindario.com", INTERNET_DEFAULT_FTP_PORT, "usuario", "password", INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
DoEvents
FtpSetCurrentDirectory hConnection, "\"
DoEvents
FtpPutFile hConnection, "C:\ruta_local.txt", "nombre_remoto.txt", FTP_TRANSFER_TYPE_UNKNOWN, 0
DoEvents
InternetCloseHandle hConnection
InternetCloseHandle hOpen

esperando el tuyo...

saludos

[zabait]

muy bien, ahí va el mio...

Código:

Function ENVIARFTP

Public bActiveSession As Boolean
Public hOpen As Long, hConnection As Long
Public dwType As Long

'Conectarse a internet
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'    If hOpen = 0 Then ErrorOut Err.LastDllError, "InternetOpen"
    If hOpen = 0 Then
        txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - ERROR de conexión a internet." & _
                        vbCrLf & txtProceso
        Exit Sub
    End If
    
'Datos del servidor FTP
    
    Dim ipServidor As String
    Dim usuario As String
    Dim pwd As String
    Dim datos As String
    Dim rs As New ADODB.Recordset
    
    If Not bActiveSession And hOpen <> 0 Then
    
        Dim nFlag As Long
        
'        nFlag = INTERNET_FLAG_PASSIVE      'MODO PASIVO
        nFlag = 0                           'MODO ACTIVO

        hConnection = InternetConnect(hOpen, ipServidor, INTERNET_INVALID_PORT_NUMBER, _
        usuario, pwd, INTERNET_SERVICE_FTP, nFlag, 0)
        If hConnection = 0 Then
            bActiveSession = False
            txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ")-  ERROR de conexión con el servidor." & _
                            vbCrLf & txtProceso
        Else
            bActiveSession = True
       End If
       
    End If
    
    '*****************************************************************************************
    'Envío de documentos al servidor FTP
    '*****************************************************************************************
    
    Dim errorLocalizable As Boolean
    Dim txtErrorLocalizable As String
    
    errorLocalizable = False
    txtErrorLocalizable = ""
    
    Dim fila As Integer
    
    With FGPendientes
        
        For fila = 1 To .Rows - 1
        'recorremos todas las lineas del grid de documentos pendientes de envío
        
        
            On Error GoTo errorEnvio
            
            Dim bRet As Boolean
            Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
            Dim szTempString As String
            Dim nPos As Long, nTemp As Long
            Dim auxStr As String
            
            If bActiveSession Then
                            
                auxStr = [Obetenemos datos de donde debemos guardar el documento en el Servidor FTP]
                
                szTempString = ipServidor
                szDirRemote = "\"
                szFileRemote = auxStr
                szFileLocal = [Obtenemos el dato del directorio local]
                
                txtProceso = Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Enviando documento ... " & _
                            Right(szFileLocal, Len(szFileLocal) - InStrRev(szFileLocal, "\")) & _
                            vbCrLf & txtProceso
                
                rcd szDirRemote
                
                bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, dwType, 0)
                 
                If bRet = False Then
                    txtErrorLocalizable = "Error al intentar grabar el documento en el servidor FTP."
                    errorLocalizable = True
                    GoTo errorEnvio
                Else
                    
                    txtProceso = Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Documento enviado." & _
                            Right(szFileLocal, Len(szFileLocal) - InStrRev(szFileLocal, "\")) & _
                            vbCrLf & txtProceso
                End If
           End If
           
           On Error GoTo 0
           GoTo seguir
           
errorEnvio:

            If Not errorLocalizable Then
                txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Error indetectable en el envío del documento " & szFileLocal & _
                            vbCrLf & txtProceso
            Else
                txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - " & txtErrorLocalizable & _
                            vbCrLf & txtProceso
            End If

End function

Se necesita un .bas que no puedo adjuntar porque es demaiado largo.
Si alguien lo quiere... que se ponga en contacto conmigo

De todas formas, muy buen código el tuyo.
Si realmente funciona (que ahora no puedo probarlo), muy bueno. felicidades!!!

¿¿¿¿A que se parecen????

[M1gu3l]

se que este tema es viejo pero alguien me puede aclarar como se usan esos codigos??por ejemplo el primero

[pkj]

No lo voy a probar por que no tengo anda que enviar pero se supone que funciona así:

Ejm: Creas un formulario con un botón "Command1" y 5 textbox llamados
Direccion, Nombre, Password, Fichero, NuevoFichero

y pegas este código:

Código :

'Declaraciones
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const PassiveConnection As Boolean = True
Const INTERNET_FLAG_PASSIVE = &H8000000
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
 
Dim hConnection, hOpen, Num As Long
 
 
Private Sub Command1_Click()
 
  SubirArchivo Direccion.text, Nombre.text, Password.text, Fichero.text, NuevoFichero.text
 
End Sub
 
Private Sub SubirArchivo(ByVal strDireccion As String, ByVal strNombre As String, ByVal strPassword As String, ByVal strFichero As String, ByVal strNuevoFichero As String)
  hOpen = InternetOpen("IE", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
  DoEvents
  hConnection = InternetConnect(hOpen, strDireccion, INTERNET_DEFAULT_FTP_PORT, strNombre, strPassword, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
  DoEvents
  FtpSetCurrentDirectory hConnection, "\"
  DoEvents
  FtpPutFile hConnection, strFichero, strNuevoFichero, FTP_TRANSFER_TYPE_UNKNOWN, 0
  DoEvents
  InternetCloseHandle hConnection
  InternetCloseHandle hOpen
End Sub
 

Lo ejecutas, rellenas los textbox con los valores que indican sus nombres y pinchas en el botón.

[M1gu3l]

gracias,me estoy iniciando en visual basic y estoy mirando codigos fuente.
lo que no me quedo claro es lo que hay que poner en nuevo fichero

[pkj]

NuevoFichero es el nombre que se le dará al fichero una vez copiado.
Puedes mandar un fichero y que al llegar se guarde con diferente nombre.
No tienes que incluir la ruta, solo el nombre y extensión que quieras que use el nuevo fichero.
Puedes añadir esta sub para facilitar la tarea:

Código :

Private Sub Nombre_Change()
  NuevoNombre.Text = Dir$(Nombre.Text)
End Sub
 

Así cuando cargues un fichero en el textbox Nombre, el textbox NuevoNombre se cargará automáticamente con el nombre y extensión del fichero cargado, que es lo que normalmente vas a usar.
Nota: Para que se cargue el textbox NuevoNombre, el fichero cargado en el textbox Nombre debe existir e incluir la ruta completa. Ejm: C:\Fichero.txt

Espero haberme explicado.

[M1gu3l]

muchas gracias =) da gusto la gente como tu

[pkj]

Es un placer.
Ya nos dirás si funciona.
Yo, como digo, no lo he probado (ni siquiera he arrancado el vb para modificar el código) porque no tengo donde mandar nada, pero quien sabe si un dia...

[M1gu3l]

Iniciado por M1gu3l

muchas gracias =) da gusto la gente como tu

si,funcionó perfecto,le hice un par de retoques y ya