Subida de Archivo a FTP Automatico?

[P4nd3m0n1um]

bien resulta q estoy trabajandon en un simple programa q envia un archivo jpg para actualizar el sitio aca un cierto tiempo. os pongo el code, y el source para bajar. este por ejemplo esta con txt.

FORM1:

Código (vb) [Seleccionar] Expandir

Option Explicit

'Variable Para la clase
Dim Ftp As Class1

'Conectar al servidor FTP.
'***********************************

Private Sub cmdConectar_Click()
 
  With Ftp
 
     .Inicializar Me
     'Le establecemos la contraseña de la cuenta Ftp
     .PassWord = txtPassword
     
     'Le establecemos el nombre de usuario de la cuenta
     .Usuario = txtUsuario
     
     'Establecesmo el nombre del Servidor FTP
     .Servidor = txtServidor
     
     '...conectamos al servidor FTP. EL label es el control donde mostrar _
      los errores y el estado de la conexión
     If .ConectarFtp(Label4) = False Then
         MsgBox "No se puedo conectar"
        Exit Sub
      End If
     'Mostramos en el label el path del directorio actual donde estamos _
      ubicados en el servidor
      lblDiractual = Ftp.GetDirectorioActual
     
      'Le indicamos el ListView donde se listarán los archivos
      Set .ListView = ListView1
     
     .ListarArchivos
  End With
     'Habilitamos los controles del frame2 (subir archivo, bajar, borrar etc..)
     Frame2.Enabled = True
     
End Sub

Private Sub CmdDesconectar_Click()
'Desconectamos del servidor FTP
Ftp.Desconectar
Frame2.Enabled = False
End Sub

'Establece el modo de transferencia (binario, Ascii o desconocido)
Private Sub Combo1_Click()
Select Case Combo1.ListIndex
 Case 0: Ftp.TipoTransferencia = [ ASCII ]
 Case 1: Ftp.TipoTransferencia = [ BINARIO ]
 Case 2: Ftp.TipoTransferencia = [ DESCONOCIDO ]
End Select

End Sub

'Crear Directorio en el directorio FTP actual
Private Sub Command1_Click()
Dim carpeta As String
carpeta = InputBox("Escriba el nombre de la carpeta", "Crear directorio")
If carpeta <> "" Then
  Ftp.CrearDirectorio carpeta
End If
End Sub


'Sube un archivo al FTP
Private Sub Command3_Click()
'On Error GoTo errsub
Dim i As Integer
cd.CancelError = True
'cd.ShowOpen
If cd.FileName = "F:\code\sitio\tren.txt" Then Exit Sub

For i = 1 To ListView1.ListItems.Count
   If cd.FileTitle = ListView1.ListItems(i) Then
      If MsgBox("El archivo que itenta subir ya existe. ¿Sobreescribirlo?", _
                 vbQuestion + vbYesNo) = vbYes Then

        ListView1.ListItems.Remove i
        Ftp.SubirArchivo cd.FileName, cd.FileTitle
        Exit Sub
       Else
        Exit For
      End If
   End If
Next

Ftp.SubirArchivo cd.FileName, cd.FileTitle

Exit Sub
errsub:
If Err.Number = 32755 Then Exit Sub
End Sub

Private Sub Command2_Click()
   'Actualiza el ListView mostrando los dir y archivos del dir Ftp actual
   Ftp.Actualizar
End Sub


'Renombrar archivo remoto
Private Sub Command4_Click()
Dim localFile As String, nuevoNombre As String

nuevoNombre = InputBox("Se va a renombrar el archivo: " & ListView1.SelectedItem & vbCrLf & "Escriba el nuevo nombre para este archivo")

If nuevoNombre = "" Then Exit Sub

Ftp.RenombrarArchivo ListView1.SelectedItem, nuevoNombre

End Sub


'Eliminar archivo
Private Sub Command5_Click()
If ListView1.SelectedItem Is Nothing Then MsgBox "No hay ningún archivo seleccionado para eliminar", vbInformation: Exit Sub

If MsgBox("Eliminar el archivo:" & ListView1.SelectedItem & "??", vbYesNo + vbExclamation) = vbYes Then
  Ftp.EliminarArchivo ListView1.SelectedItem
  ListView1.ListItems.Remove ListView1.SelectedItem.Index
End If
End Sub


'Eliminar carpeta Ftp
Private Sub Command6_Click()
If ListView1.SelectedItem Is Nothing Then MsgBox "No hay ninguna carpeta seleccionada para eliminar", vbInformation: Exit Sub

If MsgBox("Eliminar el Directorio: " & vbCrLf & ListView1.SelectedItem & "??", vbYesNo + vbExclamation) = vbYes Then
  Ftp.EliminarDirectorio ListView1.SelectedItem
  ListView1.ListItems.Remove ListView1.SelectedItem.Index
End If


End Sub

'Descarga un archivo del FTP
Private Sub Command7_Click()
Dim pathLocal As String
pathLocal = InputBox("Escriba la ruta donde descargar el archivo remoto" & vbCrLf & ListView1.SelectedItem, "descargar archivo", "c:\")
 If pathLocal = "" Then
    Exit Sub
 Else
    Ftp.ObtenerArchivo ListView1.SelectedItem, pathLocal & _
                       ListView1.SelectedItem
 End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Eliminamos la referencia de la clase
Set Ftp = Nothing
End Sub

'Cambia de directorio y actualiza la lista al hacer dobleclick
Private Sub ListView1_DblClick()
If ListView1.SelectedItem.SmallIcon = "carpeta" Then
  'cambiamos de Dir
  Ftp.CambiarDirectorio ListView1.SelectedItem
  Ftp.ListarArchivos 'Lista los archivos
  'Mostramos el directorio actual en el Label
  lblDiractual = Ftp.GetDirectorioActual
 
End If
End Sub



Private Sub Form_Load()
Set Ftp = New Class1
Combo1 = Combo1.List(0)
  With Ftp
 
     .Inicializar Me
     'Le establecemos la contraseña de la cuenta Ftp
     .PassWord = txtPassword
     
     'Le establecemos el nombre de usuario de la cuenta
     .Usuario = txtUsuario
     
     'Establecesmo el nombre del Servidor FTP
     .Servidor = txtServidor
     
     '...conectamos al servidor FTP. EL label es el control donde mostrar _
      los errores y el estado de la conexión
     If .ConectarFtp(Label4) = False Then
         MsgBox "No se puedo conectar"
        Exit Sub
      End If
     'Mostramos en el label el path del directorio actual donde estamos _
      ubicados en el servidor
      lblDiractual = Ftp.GetDirectorioActual
     
      'Le indicamos el ListView donde se listarán los archivos
      Set .ListView = ListView1
     
     .ListarArchivos
  End With
     'Habilitamos los controles del frame2 (subir archivo, bajar, borrar etc..)
     Frame2.Enabled = True
     On Error GoTo errsub
Dim i As Integer
'cd.CancelError = True
'cd.ShowOpen
If cd.FileName = "F:\code\sitio\tren.txt" Then Exit Sub

For i = 1 To ListView1.ListItems.Count
   If cd.FileTitle = ListView1.ListItems(i) Then
      If MsgBox("El archivo que itenta subir ya existe. ¿Sobreescribirlo?", _
                 vbQuestion + vbYesNo) = vbYes Then
         
         ListView1.ListItems.Remove i
         Ftp.SubirArchivo cd.FileName, cd.FileTitle
         Exit Sub
       Else
         Exit For
      End If
   End If
Next

Ftp.SubirArchivo cd.FileName, cd.FileTitle

Exit Sub
errsub:
If Err.Number = 32755 Then Exit Sub
End Sub


Class1:

Código (vb) [Seleccionar] Expandir


'Path mas largo
Private Const MAX_PATH = 260
'Constante para el atributo de directorio
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Type SYSTEMTIME
   intYear As Integer
   intMonth As Integer
   intDayOfWeek As Integer
   intDay As Integer
   intHour As Integer
   intMinute As Integer
   intSecond As Integer
   intMilliSeconds As Integer
End Type


'--- tipos de archivos --- para el Upload y Download
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2

'Puerto FTP
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1

' Modo de conexión FTP
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const PassiveConnection As Boolean = True

'--- formas de entrar en internet ---
' usa config del registro
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
' directo a internetnet
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
' via  proxy
Private Const INTERNET_OPEN_TYPE_PROXY = 3
' prevent using java/script/INS
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4

'Type para atributos de fecha y hora de archivos
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

'Otros atributos de archivo tamaño, nombre, fecha etc..
Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

' Declaraciones Apis
'***************************************************************


Private Declare Function InternetCloseHandle _
 Lib "wininet.dll" (ByVal hInet As Long) As Integer
'Establece una conexión a internet para poder iniciar seción Ftp
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
'Conecta al Ftp
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
'Establece el path corriente
Private Declare Function FtpSetCurrentDirectory _
  Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
  (ByVal hFtpSession As Long, _
   ByVal lpszDirectory As String) As Boolean
'Recupera el path corriente
Private Declare Function FtpGetCurrentDirectory _
  Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
 (ByVal hFtpSession As Long, _
  ByVal lpszCurrentDirectory As String, _
  lpdwCurrentDirectory As Long) As Long
'Crea un directorio
Private Declare Function FtpCreateDirectory _
  Lib "wininet.dll" Alias "FtpCreateDirectoryA" _
  (ByVal hFtpSession As Long, _
  ByVal lpszDirectory As String) As Boolean
'Elimina un directorio del FTP
Private Declare Function FtpRemoveDirectory _
 Lib "wininet.dll" Alias "FtpRemoveDirectoryA" _
 (ByVal hFtpSession As Long, _
 ByVal lpszDirectory As String) As Boolean
'Borra un fichero
Private Declare Function FtpDeleteFile _
 Lib "wininet.dll" Alias "FtpDeleteFileA" _
 (ByVal hFtpSession As Long, _
 ByVal lpszFileName As String) As Boolean
'Renombra un fichero
Private Declare Function FtpRenameFile _
 Lib "wininet.dll" Alias "FtpRenameFileA" _
 (ByVal hFtpSession As Long, _
 ByVal lpszExisting As String, _
 ByVal lpszNew As String) As Boolean
'Recupera un archivo
Private Declare Function FtpGetFile Lib "wininet.dll" _
  Alias "FtpGetFileA" (ByVal hConnect As Long, _
 ByVal lpszRemoteFile As String, _
 ByVal lpszNewFile As String, ByVal fFailIfExists As Long, _
 ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
 ByRef dwContext As Long) As Boolean
'Escribe un archivo
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
'Api Para los errores
Private Declare Function InternetGetLastResponseInfo _
 Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
 (lpdwError As Long, ByVal lpszBuffer As String, _
  lpdwBufferLength As Long) As Boolean
'Busca el primer archivo de un path
Private Declare Function FtpFindFirstFile Lib "wininet.dll" _
  Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, _
  ByVal lpszSearchFile As String, _
  lpFindFileData As WIN32_FIND_DATA, _
  ByVal dwFlags As Long, ByVal dwContent As Long) As Long
'api para buscar el siguiente archivo
Private Declare Function InternetFindNextFile Lib "wininet.dll" _
  Alias "InternetFindNextFileA" (ByVal hFind As Long, _
  lpvFindData As WIN32_FIND_DATA) As Long



Public Enum e_TipoTransferencia
[ BINARIO ] = FTP_TRANSFER_TYPE_BINARY
[ ASCII ] = FTP_TRANSFER_TYPE_ASCII
[ DESCONOCIDO ] = FTP_TRANSFER_TYPE_UNKNOWN
End Enum

   'Handle de la conexión Ftp
   Dim HandleConect As Long
   'Handle de la conexión a Internet
   Dim hOpen As Long
   
'Variables locales
Private m_DirectorioActual As String
Private m_Usuario As String
Private m_PassWord As String
Private m_Servidor As String
Private m_DirAnterior As String
Private m_listView As ListView
Private m_TipoTransferencia  As Long
Private m_form As Form

Private ctrl As Object

'Funciones Varias para el manejo de archivos y carpetas en el servidor Ftp
'***********************************************************************
'***********************************************************************

'Rutina que conecta al Servidor Ftp
Public Function ConectarFtp(Optional ControlStatus As Object _
                           = Nothing) As Boolean
   
'Verificamos que los datos de la cuenta estén establecidas, si no mostramos un _
mensaje y salimos
If m_Usuario = "" Or m_Servidor = "" Or m_PassWord = "" Then
  MsgBox "No se puede conectar. Verifique el Nombre de usuario," _
  & "El nombre del Servidor y la contraseña que estén establecidas", vbCritical
  ConectarFtp = False
  Exit Function
End If
   

  Set ctrl = ControlStatus
  Status "...Intentando conectar a: " & m_Servidor
  m_form.MousePointer = vbHourglass
   
'Abrimos una conexión a Internet
hOpen = InternetOpen(vbNullString, _
       INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, _
       vbNullString, 0)

If hOpen = 0 Then
  Status "Error en la conexión a internet, compruebe la conexión"
  m_form.MousePointer = vbDefault
  ConectarFtp = False
  Exit Function
End If
'Conectamos al servidor FTP, pasandole los datos: login y servidor
HandleConect = InternetConnect(hOpen, m_Servidor, _
              INTERNET_DEFAULT_FTP_PORT, m_Usuario, _
              m_PassWord, INTERNET_SERVICE_FTP, _
              IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
             
If HandleConect = 0 Then
  Status "Error. Compruebe los datos del servidor Ftp sin son correctos"
  m_form.MousePointer = vbDefault
  ConectarFtp = False
  Exit Function
End If
Status "Conectado a: " & m_Servidor
m_form.MousePointer = vbDefault
ConectarFtp = True
End Function

'Desconecta del servidor FTP
'**************************************************
Public Sub Desconectar()
   Dim ret As Long
   'cierra la conexion FTP
   ret = InternetCloseHandle(HandleConect)
   If ret = 0 Then Status "Error al desconectar": Exit Sub
   'cierra la conexion a internet
   ret = InternetCloseHandle(hOpen)
   If ret = 0 Then Status "Error al desconectar": Exit Sub
   
   Status "Desconectado de: " & m_Servidor
   Class_Terminate
End Sub

'Recupera el directorio actual donde estamos ubicados
'*****************************************************
Public Function GetDirectorioActual() As String
   'Crea un buffer
   m_DirectorioActual = String(MAX_PATH, 0)
   'Obtenemos el directorio actual
    ret = FtpGetCurrentDirectory(HandleConect, m_DirectorioActual, _
          Len(m_DirectorioActual))
    GetDirectorioActual = m_DirectorioActual
End Function

'Establecemos el Directorio Actual
'****************************************************
Public Sub CambiarDirectorio(PathDirectorio As String)
   
       
   Dim pData As WIN32_FIND_DATA
   Dim hFind As Long  'handle usado para buscar fichs en FTP
   Dim ret As Long
   Dim strDir As String
   
   
   
   strDir = Replace(m_DirectorioActual, Chr(0), "")
   
   If strDir = "/" And PathDirectorio = "../Subir un nivel" Then: Exit Sub
   
   m_form.MousePointer = vbHourglass
   
   If PathDirectorio = "../Subir un nivel" Then
     pos = InStrRev(strDir, "/")
     strDir = Left(strDir, pos)
     
     
     
     'Cambia al Directorio Ftp especificado
      ret = FtpSetCurrentDirectory(HandleConect, strDir)
     
      If ret = 0 Then
         Status "Error al cambiar de directorio."
      End If
      m_form.MousePointer = vbDefault
      Exit Sub
   End If
   
   'Cambia al Directorio especificado
   ret = FtpSetCurrentDirectory(HandleConect, strDir & "/" & PathDirectorio)
   
   If ret = 0 Then
      Status "Error al cambiar de directorio"
   End If
   m_form.MousePointer = vbDefault
   
End Sub


'Crea un nuevo directorio
'*******************************************
Public Sub CrearDirectorio(NameDirectorio As String)

'Creamos un nuevo  directorio ('testing')
ret = FtpCreateDirectory(HandleConect, NameDirectorio)
If Not ret Then
  Status "Error al crear el directorio, compruebe el nombre que sea válido"
Else
  m_listView.ListItems.Add , , NameDirectorio, , "carpeta"
  m_listView.ListItems(m_listView.ListItems.Count).Selected = True
  m_listView.SetFocus
End If
 
End Sub

'Crea o sube un nuevo Archivo.
'********************************************
Public Sub SubirArchivo(localArchivo As String, NombreArchivoRemoto As String)
'manda fichero al servidor FTP
ret = FtpPutFile(HandleConect, localArchivo, NombreArchivoRemoto, _
          m_TipoTransferencia, 0)
If ret Then
  m_listView.ListItems.Add , , NombreArchivoRemoto, , "archivo"
  m_listView.ListItems(m_listView.ListItems.Count).Selected = True
  m_listView.SetFocus
Else
  Status "Error al subir el fichero:" & NombreArchivoRemoto
End If
End Sub
   
   
'Renombra un archivo en el directorio Ftp corriente
'****************************************************
Public Sub RenombrarArchivo(Archivo As String, nuevoNombre As String)

'renombra 'test.htm' to 'apiguide.htm'
ret = FtpRenameFile(HandleConect, Archivo, nuevoNombre)

If ret Then
  m_listView.SelectedItem.Text = nuevoNombre
  m_listView.SetFocus
Else
  Status "Error al renombrar el fichero:" & nuevoNombre
End If

End Sub


Public Sub ObtenerArchivo(ArchivoRemoto As String, ArchivoLocal As String, _
          Optional SobreEscribir As Boolean = False)
'recupera fichero del servidor FTP: ArchivoRemoto es el nombre del archivo remoto
'ArchivoLocal es el nombre y ruta donde se colocará el archivo en local
ret = FtpGetFile(HandleConect, ArchivoRemoto, ArchivoLocal, _
          SobreEscribir, 0, m_TipoTransferencia, 0)

If ret Then
  Status "Archivo descargado correctamente:"
  m_listView.SetFocus
Else
  Status "Error al intentar descargar el fichero: " & ArchivoRemoto
End If

End Sub

'Eliminar Archivo del servidor Ftp
Public Sub EliminarArchivo(Archivo As String)
'elimina el fichero del servidor FTP
ret = FtpDeleteFile(HandleConect, Archivo)
If Not ret Then
   Status "Error. No se pudo eliminar el archivo: " & Archivo
End If
End Sub


Public Sub EliminarDirectorio(Directorio As String)
'elimina el directorio
ret = FtpRemoveDirectory(HandleConect, Directorio)
If Not ret Then
   Status "Error. No se pudo eliminar el Directorio: " & Directorio
End If
End Sub

Private Sub Status(mensaje As String)
On Error GoTo SubError
ctrl = mensaje
Exit Sub
SubError:
If Err.Number = 91 Then Resume Next
End Sub


Public Sub ListarArchivos()
   Dim Item As ListItem
   Dim pData As WIN32_FIND_DATA
   Dim hFind As Long  'handle usado para buscar fichs en FTP
   Dim ret As Long   'valor devuelto por API
   

   m_form.MousePointer = vbHourglass
   
   'crea buffer
   pData.cFileName = String(MAX_PATH, 0)
   
   'busca el primer fichero
   hFind = FtpFindFirstFile(HandleConect, "*.*", pData, 0, 0)
   
   m_listView.ListItems.Clear
   
   'Si Hfind vale 0 es porque no hay archivos ni directorios
   If hFind = 0 Then
      Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
      Item.SubItems(2) = getFecha(pData)
      m_form.MousePointer = vbDefault
      Exit Sub
   End If
   
   
   Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
   
   If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
      Item.SubItems(2) = getFecha(pData)
   Else
     
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
      Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
      Item.SubItems(2) = getFecha(pData)
   End If
   
   'si no hay mas Archivos sale
   If hFind = 0 Then
      m_form.MousePointer = vbDefault
      Exit Sub
   End If
   Do
       'crea buffer
       pData.cFileName = String(MAX_PATH, 0) 'se llena con nulos
       'find the next file
       ret = InternetFindNextFile(hFind, pData)
       'si no hay ficheros, no sigue
       If ret = 0 Then Exit Do

   
   If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Or _
                              pData.dwFileAttributes = 0 Then
      'Agrega el nombre del directorio
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
      Item.SubItems(2) = getFecha(pData)
   Else
      'agrega el archivo y Muestra el tamaño del mismo en el LV
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
      Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
      Item.SubItems(2) = getFecha(pData)
   End If
   
   Loop
   'Cerramos el handle de búsqueda
   InternetCloseHandle hFind
   m_listView.Sorted = True
   m_form.MousePointer = vbDefault
End Sub


'Actualiza la lista de Archivos y directorios en el ListView
'************************************************************
Public Sub Actualizar()

   Dim pData As WIN32_FIND_DATA
   Dim hFind As Long  'handle usado para buscar fichs en FTP
   Dim ret As Long   'valor devuelto por API
   Dim Item As ListItem
   
   
   m_form.MousePointer = vbHourglass
   
   'crea buffer
   pData.cFileName = String(MAX_PATH, 0)
   
   'busca el primer fichero
   hFind = FtpFindFirstFile(HandleConect, "*.*", pData, 0, 0)
   
   m_listView.ListItems.Clear
   
   If hFind = 0 Then
      Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
      m_form.MousePointer = vbDefault
      Exit Sub
   End If
   
   
   Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
   
   If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
      Item.SubItems(2) = getFecha(pData)
   Else
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
      Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
      Item.SubItems(2) = getFecha(pData)
   End If
   
   'si no hay mas Archivos sale
   If hFind = 0 Then
      m_form.MousePointer = vbDefault
      Exit Sub
   End If
   Do
       'crea buffer
       pData.cFileName = String(MAX_PATH, 0) 'se llena con nulos
       'find the next file
       ret = InternetFindNextFile(hFind, pData)
       'si no hay ficheros, no sigue
       If ret = 0 Then Exit Do
       'Archivo

   If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Or pData.dwFileAttributes = 0 Then
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
      Item.SubItems(2) = getFecha(pData)
     
   Else
      Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")

      Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
      Item.SubItems(2) = getFecha(pData)
     

     
     
   End If
   
   Loop
   'Cerramos el handle de búsqueda
   InternetCloseHandle hFind
   m_listView.Sorted = True
   m_form.MousePointer = vbDefault
End Sub


Private Function getFecha(pData As WIN32_FIND_DATA) As Date
  Dim stSystemTime As SYSTEMTIME

           If FileTimeToSystemTime(pData.ftLastWriteTime, stSystemTime) > 0 Then
               VBATime = DateSerial(stSystemTime.intYear, _
                stSystemTime.intMonth, _
               stSystemTime.intDay) + TimeSerial(stSystemTime.intHour, _
               stSystemTime.intMinute, stSystemTime.intSecond)
           End If
           getFecha = VBATime
End Function


Public Sub Inicializar(Formulario As Form)
    Set m_form = Formulario
End Sub

'Para mostrar los errores
'************************************************+
Private Sub ShowError()
   Dim lngNumError As Long
   Dim strMemoError As String
   Dim lngTamBuffer As Long
   '-----------------------------
   'Tamaño del buffer
   InternetGetLastResponseInfo lngNumError, _
      strMemoError, lngTamBuffer
   'crea buffer
   strMemoError = String(lngTamBuffer, 0)
   'Recupera informacion del error
   InternetGetLastResponseInfo lngNumError, _
       strMemoError, lngTamBuffer
   'Mostrar el error en msgbox
   MsgBox "Error " & CStr(lngNumError) & ": " & strMemoError, _
      vbOKOnly Or vbCritical
End Sub


'Nombre de usuario de la cuenta Ftp
'**********************************
Public Property Get Usuario() As String
Usuario = m_Usuario
End Property

Public Property Let Usuario(ByVal vNewValue As String)
m_Usuario = vNewValue
End Property

'Nombre del servidor Ftp
'***********************
Public Property Get Servidor() As String
Servidor = m_Servidor
End Property

Public Property Let Servidor(ByVal vNewValue As String)
m_Servidor = vNewValue
End Property

'Contraseña de la cuenta FTP
'***************************
Public Property Get PassWord() As String
PassWord = m_PassWord
End Property

Public Property Let PassWord(ByVal vNewValue As String)
m_PassWord = vNewValue
End Property

'Establece el ListView donde listar los ficheros
'***********************************************
Public Property Get ListView() As ListView
Set ListView = m_listView
End Property

Public Property Set ListView(ByVal vNewValue As ListView)
Set m_listView = vNewValue
End Property

'Modo de Transferencia
'**********************************************
Public Property Get TipoTransferencia() As e_TipoTransferencia
   TipoTransferencia = m_TipoTransferencia
End Property
Public Property Let TipoTransferencia(NewData As e_TipoTransferencia)
   m_TipoTransferencia = NewData
End Property


Private Sub Class_Terminate()
On Local Error Resume Next
 'Cerramos la cesión FTP y la conexión a internet
 InternetCloseHandle HandleConect
 InternetCloseHandle hOpen
 'Eliminamos las variables de objeto
 Set ctrl = Nothing
 Set ListView = Nothing
 Set m_form = Nothing
End Sub


Proyecto: http://www.mediafire.com/?irabj2910123ird

Ahora mi problema es q mi servidor me da una carpeta "public_html"; donde tengo q guardar el archivo jpg. pero no puedo hacer que lo envie automaticamente a esa carpeta. alguien me podra dar una mano con esto?

[raul338]

Tienes que manejar bien tu clase FTP, no dejes todo el choclo de codigo

[Elemental Code]

Como todo servdor FTP, deduzco que tenes que posisionarte primero en la carpeta

Código (vb) [Seleccionar] Expandir

'Cambia de directorio y actualiza la lista al hacer dobleclick
      'Cambia al Directorio Ftp especificado
       ret = FtpSetCurrentDirectory(HandleConect, strDir)

       If ret = 0 Then
          Status "Error al cambiar de directorio."
       End If
       m_form.MousePointer = vbDefault
       Exit Sub
    End If


Y despues subirlo.

Código (vb) [Seleccionar] Expandir

Dim i As Integer
cd.CancelError = True
'cd.ShowOpen
If cd.FileName = "F:\code\sitio\tren.txt" Then Exit Sub

For i = 1 To ListView1.ListItems.Count
    If cd.FileTitle = ListView1.ListItems(i) Then
       If MsgBox("El archivo que itenta subir ya existe. ¿Sobreescribirlo?", _
                  vbQuestion + vbYesNo) = vbYes Then

         ListView1.ListItems.Remove i
         Ftp.SubirArchivo cd.FileName, cd.FileTitle
         Exit Sub
        Else
         Exit For
       End If
    End If
Next

Ftp.SubirArchivo cd.FileName, cd.FileTitle

PD:
Estas haciendo un clon de un cliente FTP?
Eso esta medio visto ya

[P4nd3m0n1um]

PD:
Estas haciendo un clon de un cliente FTP?
Eso esta medio visto ya

parecido pero ya lo he solucionado! gracias por tu ayuda!