FiveTech Support Forums

/*----------------------------------------------------------------------------------------*/
*        Archivo: Proc9991.PRG                                                            *
*    Descripcion: Subir ficheros del servidor FTP                                         *
*          Fecha: 11-03-2012                                                              *
*          Autor: Jose Javier LLoris Roig                                                 *
*            Web: http://javierlloris.blogspot.com.es/                                    *
*            Msn: fwh<!-- e --><a href="mailto:-jll@hotmail.es">-jll@hotmail.es</a><!-- e -->                                                      *
*                                                                                         *
*       Libreria: FWH/FWHX 11.09                                                          *
*        Harbour: Harbour 5.8.2 release 20120330                                          *
*     Compilador: Borland C++ 5.8.2                                                       *
*            S.O: XP/Win7 no probado en otros S.O                                         *
*                                                                                         *
*    Copyright (C) 2012 José Javier Lloris Roig                                           *
*    Correo electrónico: fwh<!-- e --><a href="mailto:-jll@hotmail.es">-jll@hotmail.es</a><!-- e -->                                               *
*    Web: http://javierlloris.blogspot.com.es/                                            *
*                                                                                         *
*    Este programa es software libre: usted puede redistribuirlo y/o modificarlo bajo los *
*    términos de la Licencia Pública General GNU publicada por la Fundación para el       *
*    Software Libre, ya sea la versión 3 de la Licencia, o (a su elección) cualquier      *
*    versión posterior.                                                                   *
*                                                                                         *
*    Este programa se distribuye con la esperanza de que sea útil, pero SIN GARANTÍA      *
*    ALGUNA; ni siquiera la garantía implícita MERCANTIL o de APTITUD PARA UN PROPÓSITO   *
*    DETERMINADO.                                                                         *
*                                                                                         *
*    Consulte los detalles de la Licencia Pública General GNU para obtener una información*
*    más detallada.                                                                       *
*                                                                                         *
*    Debería haber recibido una copia de la Licencia Pública General GNU                  *
*    junto a este programa. En caso contrario, consulte http://www.gnu.org/licenses.      *
/*----------------------------------------------------------------------------------------*/

#Include "FiveWin.CH"

STATIC oFTP
STATIC lFTP := .F.
STATIC aFiles
STATIC nSizeFiles

/*------------------------------------------------------------------------------*/
FUNCTION oGetoFTP()
Return oFTP
/*------------------------------------------------------------------------------*/
FUNCTION lIsOpenFTP()
Return lFTP
/*------------------------------------------------------------------------------*/
Function CierraFTP()
If lIsOpenFTP()
    oFTP:Close()
EndIf

DeleteObject( oFTP )
oFTP := NIL
lFTP := .F.

Return Nil
/*------------------------------------------------------------------------------*/
Function lConectaFTP( AMPAARRA )
/*------------------------------------------------------------------------------*/
Local lOk   := .F.

Local cPasswordFTP := RTrim( AMPAarra[2][3][1][19] ) + Space(25)


// comprobamos si tenemos conexion a internet
IF !IsInternet()
    MsgAlert( "Compruebe la conexión a Internet.", "Atención" )
    Return (lFTP := .F.)
END
   
aFiles     := {}
nSizeFiles := 0

/* Comprobamos que en la BD Ftp.DBF estan los datos introducidos para poder */
/* acceder al servidor FTP                                                  */
IF EMPTY( AMPAarra[2][3][1][17] ) .OR.; // Nombre del servidor FTP
   EMPTY( AMPAarra[2][3][1][18] ) .OR.; // Nombre del usuario FTP
   EMPTY( AMPAarra[2][3][1][19] ) .OR.; // Password del usuario del FTP
   EMPTY( AMPAarra[2][3][1][20] )       // Nombre de la carpeta destino en el servidor FTP

    MsgAlert( "Debe de configurar el programa para poder"      +CRLF+;
              "acceder al servidor FTP. Entre en el apartado"  +CRLF+;
              "Configurar programa y introduzca la información"+CRLF+;
              "requerida y vuelva a intentarlo."               +CRLF+CRLF+;
              "Pulse el boton de aceptar para continuar.", "ERROR!!" )
    Return (lFTP := .F.)

END

MsgGet( GetTrad("Atenció!"), RTrim( AMPAarra[2][3][1][17] ) + "-" + RTrim( AMPAarra[2][3][1][18] ) + "-" + GetTrad("Indiqui el Password:"), @cPasswordFTP )
 
MsgRun( "Conectando con el servidor FTP",;
        "Espere por Favor..."           ,;
        { || oFtp := ServicesFTP():New( RTrim( AMPAarra[2][3][1][17] ) ,; // Servidor
                                        RTrim( AMPAarra[2][3][1][18] ) ,; // Usuario
                                        AllTrim(cPasswordFTP)         , ;    // RTrim( AMPAarra[2][3][1][19] ) ,; // Contraseña
                                        AMPAarra[2][3][1][21]          ,; // Permitir anonimos
                                        AMPAarra[2][3][1][22]          ,; // Tiempo de respuesta
                                        AMPAarra[2][3][1][23]         )}) // Puerto
SysRefresh()

IF (lOk := (oFtp:nError == 0))

    /* Aqueta funció és molt important per que a més a més de carregar
       fitxers en la array 'aFiles', es situa en el directori de FPT.
       ------------------------------------------------------------ */
    CargaFiles( RTrim( AMPAarra[2][3][1][20] ) )

END

Return ( lFTP := lOk )
/*------------------------------------------------------------------------------*/
Function SubeFichero( AMPAARRA, cFile, lMensaje )
/*------------------------------------------------------------------------------*/

/* Esta función puede usarse sola (directamente), con lo cual en ella se
   realiza la conexión a FTP, o precedida del uso de lConectaFTP() y posprecedida de
   CierraFTP(), y en ese caso no se realizará la conexión a FTP en esta función ya que
   se habrá realizado previamente en lConectaFTP().
   Para controlar esta situación se usa la variable lConectadoFTPenSubefichero .
   -------------------------------------------------------------------------------- */
Local lConectadoFTPenSubefichero := .F.

LOCAL cFilePut  := ""
LOCAL cDirBack  := ""
LOCAL lSubido   := .F.

If .Not. lIsOpenFTP()
    If .Not. lConectaFTP( AMPAARRA )
        Return .F.
    EndIf
    lConectadoFTPenSubefichero := .T.
EndIf

cDirBack := oFtp:GetPath()

oFtp:oFtp:Cwd( oFtp:GetPath() )

IF !Empty( cFile )

    /* Buscamos si ya existe el fichero en el servidor ftp */
    IF AScan( aFiles, { | aFile | Lower( aFile[1] ) == Lower( cFileNoPath( cFile ) ) } ) > 0

        IF MsgNoYes( "Archivo: " + Lower( cFileNoPath( cFile ) ) + CRLF + CRLF + ;
                     "El fichero ya existe en su sitio FTP." + CRLF + CRLF + ;
                     "¿ Desea reemplazarlo ? ", "Seleccione..." )

            /* Borramos el fichero */
            IF !oFtp:oFtp:Dele( RTrim( cFileNoPath( cFile ) ) )

                MsgAlert( "Archivo: " + RTrim( Lower( cFileNoPath( cFile ) ) ) + CRLF + CRLF + ;
                          "No se ha podido eliminar el archivo." + CRLF + CRLF + ;
                          "Pulse el boton de aceptar para continuar.", "ERROR!!" )
                If lConectadoFTPenSubefichero
                //If lIsOpenFTP()
                    Traza( 1, "No es pot esborrar." )
                    CierraFTP()
                Endif
                Return( lSubido )
            END
          ELSE
            If lConectadoFTPenSubefichero
                CierraFTP()
            Endif
            Return( lSubido )
        END
    END
END

MsgRun( "Subiendo el archivo: " + Lower( RTrim( cFileNoPath( cFile ) ) )             ,;
        "Servidor Ftp: " + RTrim( AMPAarra[2][3][1][17]) + " Usuario: " + RTrim( AMPAarra[2][3][1][18] ),;
        { || cFilePut := oFtp:oFtp:MPut( cFile, oFtp:GetPath() )})

SysRefresh()

IF Empty( cFilePut )

    lSubido  := .F.

    If lMensaje
        MsgAlert( "Archivo: " + Lower( cFileNoPath( cFile ) )                + CRLF + CRLF + ;
                  "El archivo no se ha podido subir a su sitio FTP. Consulte"+ CRLF + ;
                  "con su administrador de sistemas o ISP los permisos"      + CRLF + ;
                  "de escritura de su sitio FTP."                            + CRLF + CRLF + ;
                  "Pulse el boton de aceptar para continuar.", "ERROR!!" )

    EndIf
    
  ELSE

    lSubido  := .T.

    If lMensaje
        MsgInfo( "Ruta de acceso remoto predeterminado: " + oFtp:GetPath() + CRLF + ;
                 "Archivo: " + Lower( cFileNoPath( cFile ) )               + CRLF + CRLF + ;
                 "El archivo se ha subido correctamente a su sitio FTP."   + CRLF + CRLF + ;
                 "Pulse el boton de aceptar para continuar." )
    EndIf
END

If lConectadoFTPenSubefichero
    CierraFTP()
Endif

If lsubido
  Else
    Inkey(1)
EndIf

Return( lSubido )
/*------------------------------------------------------------------------------*/
/*------------------------------------------------------------------------------*/
/*------------------------------------------------------------------------------*/
STATIC Function CargaFiles( cPath )
/*------------------------------------------------------------------------------*/

   DEFAULT cPath := "/"

   aFiles     := oFtp:ScrollDir( If( cPath == "/", "/", ( RTrim( cPath ) + "/" ) ) )
   nSizeFiles := oFtp:nSizeFiles

Return NIL