Copia de archivos

Post Reply
servicomver
Posts: 159
Joined: Fri Nov 18, 2005 7:34 pm

Copia de archivos

Post by servicomver »

Hola a todos, alguien sabe si es posible realizar una copia de varios archivos a una unidad X, pero que se pueda ver el avance de copiado por cada uno como un oMeter ?, y despues que termine el copiado, verificar que esten copiado realmenter y cerrar la aplicacion.

Espero haberme explicado bien.
Gracias
FRANCISDAX
Posts: 19
Joined: Sat May 05, 2012 7:10 pm
Location: Loreto - Peru

Re: Copia de archivos

Post by FRANCISDAX »

Este ejemplo lo hacia con un sistemas hecho en fw 16 bits, espero te sirva como modelo

Code: Select all

FUNCTION Copia( oWnd, oMenuItem, cCod )
  Local oDlg, oDrive, oFile, oCarp, oText
  Local cfile  := "*.DBF          "
  Local nDrive := 1
  Local cCarp  := Space( 50 )
  Local cText
  LOCAL oUse := UsarUser()

  IF( oUse:Seek( cCod ) )
    oUse:Load()
    IF !oUse:USEM39
      __StopMsg("Usuario no tiene permiso para ingresar a este M¢dulo ...")
      oUse:End()
      RETURN( NIL )
    ENDIF
    oUse:End()
  ELSE
    oUse:End()
    RETURN( NIL )
  ENDIF

  IF Len( oWnd:oWndClient:aWnd ) > 0
    __StopMsg( "!!! Cierre todas las ventanas abiertas por favor ... !!!" )
    RETURN( NIL )
  ENDIF

  Close All

  DEFINE DIALOG oDlg RESOURCE "DlgCopiar"

  REDEFINE VGET oFile VAR cFile ID 100 OF oDlg PICTURE "@!XXXXX";
          COLOR {nRgb(0,0,150),nRgb(255,255,255),nRgb(255,255,255),GetSysColor(30)},{nRgb(255,255,255),nRgb(128,128,128),nRgb(000,000,255),nRgb(000,255,255)} Tipo 1

  REDEFINE RADIO oDrive VAR nDrive ID 101, 102, 103 OF oDlg
  REDEFINE VGET oCarp VAR cCarp ID 104 OF oDlg PICTURE "@X!" When nDrive = 3;
          COLOR {nRgb(0,0,150),nRgb(255,255,255),nRgb(255,255,255),GetSysColor(30)},{nRgb(255,255,255),nRgb(128,128,128),nRgb(000,000,255),nRgb(000,255,255)} Tipo 1

  REDEFINE BUTTON ID 202 OF oDlg ACTION ( cCarp := cGetDir("Seleccionar Carpeta"),oCarp:Refresh(),oCarp:SetFocus() ) When nDrive = 3
  REDEFINE SAY oText VAR cText ID 105 OF oDlg

  REDEFINE BTNBMP ID 300 OF oDlg RESOURCE "IDrive1" NOBORDER
  REDEFINE BTNBMP ID 301 OF oDlg RESOURCE "IDrive1" NOBORDER
  REDEFINE BTNBMP ID 302 OF oDlg RESOURCE "IDrive2" NOBORDER

  REDEFINE BUTTON ID 200 OF oDlg ACTION ( IniciaCopia( cFile, nDrive, cCarp, oText ) )
  REDEFINE BUTTON ID 201 OF oDlg ACTION oDlg:End() CANCEL

  oFile:Refresh()
  oCarp:Refresh()

  ACTIVATE DIALOG oDlg;
      ON PAINT oDlg:Move( 80, 10 )

RETURN( NIL )

//----------------------------------------------------------------------------//

STATIC FUNCTION IniciaCopia( cFile, nDrive, cCarp, oText )
  Local nTest, NumFiles, i, j
  Local Ficheros := Array( ADir( cFile ) )
  Local Longitud := Array( ADir( cFile ) )

  If nDrive == 1
    SysRefresh()
    oText:SetText("  Comprobando unidad A:" )

    MsgAlert("Introduzca un disquette en la Unidad A: para la copia de ficheros", EmpSoft )

    FClose( FCreate( "A:\Check.Ctr", 0 ) )
    SysRefresh()
    nTest := FError()

    IF nTest == 5
        MsgStop ( OemToAnsi( "El disco est  protegido contra escritura. Desprot‚jalo y reintente." ), EmpSoft )
    ELSEIF nTest > 0
        MsgStop ( OemToAnsi( "Tengo problemas con el disquette o la Unidad.  Por favor, compru‚belos." ), EmpSoft )
    ELSE  
        oText:SetText ("  Cerrando ficheros ")
        dbCloseAll()
        NumFiles := aDir ( cFile, Ficheros, Longitud)
        oText:SetText ("  Borrando ficheros antiguos")
        FOR i:=1 TO NumFiles
            IF (File ( "A:\"+Ficheros[i]), FErase ( "A:\"+Ficheros[i]), )
        NEXT
        FClose( FCreate( "A:\Last.Ctr", 0 ) )

        FOR i:=1 TO NumFiles
           IF Right(Ficheros[i], 3) <> "NTX"
              IF Longitud[i] > 1400000
                 MsgStop( OemToAnsi( "Atenci¢n!!, Fichero "+Ficheros[i]+" demasiado grande, necesita compresi¢n.  Avise a su programador"), EmpSoft )
                 RETURN NIL
              ENDIF
              IF DiskSpace(1) < Longitud[i]
                 FErase( "A:\Last.Ctr")
                 IF .NOT. MsgYesNo ( OemToAnsi( "Disco lleno.  Inserte un nuevo disco en la unidad A:."+chr(13)+;
                                                             "¨ Contin£o con la copia ?"), EmpSoft ) 
                     RETURN NIL
                 ENDIF
                 oText:SetText("  Comprobando disco A:")
                 FClose( FCreate( "A:\Last.Ctr", 0 ) )
                 DO WHILE FError() > 0
                       MsgStop( OemToAnsi( "Disco no v lido.  Inserte otro"), EmpSoft )
                       FClose( FCreate( "A:\Last.Ctr", 0 ) )
                 ENDDO
                 oText:SetText("  Eliminando ficheros antiguos ")
                 FOR j:=1 TO NumFiles
                     IF (File ( "A:\"+Ficheros[j]), FErase ( "A:\"+Ficheros[j]), )
                 NEXT
              ENDIF
              oText:SetText("  Copiando fichero "+Ficheros[i])
              __CopyFile (Ficheros[i], "A:\"+Ficheros[i])
           ENDIF
        NEXT
        oText:SetText( OemToAnsi( "  Copia finalizada con ‚xito ...") )
        MsgBeep()
        MsgInfo( OemToAnsi( "Copia terminada, retire el disquette de la unidad, etiqu‚telos y prot‚jalos contra escritura" ), EmpSoft )
    ENDIF

  ElseIf nDrive == 2

    SysRefresh()
    oText:SetText(" Comprobando unidad B:" )

    MsgAlert("Introduzca un disquette en la Unidad B: para la copia de ficheros", EmpSoft )

    FClose( FCreate( "B:\Check.Ctr", 0 ) )
    SysRefresh()
    nTest := FError()

    IF nTest == 5
        MsgStop ( OemToAnsi( "El disco est  protegido contra escritura. Desprot‚jalo y reintente." ), EmpSoft )
    ELSEIF nTest > 0
        MsgStop ( OemToAnsi( "Tengo problemas con el disquette o la Unidad.  Por favor, compru‚belos." ), EmpSoft )
    ELSE  
        oText:SetText ("  Cerrando ficheros ")
        dbCloseAll()
        NumFiles := aDir ( cFile, Ficheros, Longitud)
        oText:SetText ("  Borrando ficheros antiguos")
        FOR i:=1 TO NumFiles
            IF (File ( "B:\"+Ficheros[i]), FErase ( "B:\"+Ficheros[i]), )
        NEXT
        FClose( FCreate( "B:\Last.Ctr", 0 ) )

        FOR i:=1 TO NumFiles
           IF Right(Ficheros[i], 3) <> "NTX"
              IF Longitud[i] > 1400000
                 MsgStop( OemToAnsi( "Atenci¢n!!, Fichero "+Ficheros[i]+" demasiado grande, necesita compresi¢n.  Avise a su programador"), EmpSoft )
                 RETURN NIL
              ENDIF
              IF DiskSpace(1) < Longitud[i]
                 FErase( "B:\Last.Ctr")
                 IF .NOT. MsgYesNo ( OemToAnsi( "Disco lleno.  Inserte un nuevo disco en la unidad A:."+chr(13)+;
                                                             "¨ Contin£o con la copia ?"), EmpSoft ) 
                     RETURN NIL
                 ENDIF
                 oText:SetText("  Comprobando disco B:")
                 FClose( FCreate( "B:\Last.Ctr", 0 ) )
                 DO WHILE FError() > 0
                       MsgStop( OemToAnsi( "Disco no v lido.  Inserte otro"), EmpSoft )
                       FClose( FCreate( "B:\Last.Ctr", 0 ) )
                 ENDDO
                 oText:SetText("  Eliminando ficheros antiguos ")
                 FOR j:=1 TO NumFiles
                     IF (File ( "B:\"+Ficheros[j]), FErase ( "B:\"+Ficheros[j]), )
                 NEXT
              ENDIF
              oText:SetText("  Copiando fichero "+Ficheros[i])
              __CopyFile (Ficheros[i], "B:\"+Ficheros[i])
           ENDIF
        NEXT
        oText:SetText( OemToAnsi( "  Copia finalizada con ‚xito ...") )
        MsgBeep()
        MsgInfo( OemToAnsi( "Copia terminada, retire el disquette de la unidad, etiqu‚telos y prot‚jalos contra escritura" ), EmpSoft )
    ENDIF

  ElseIf nDrive == 3
    If cCarp = Space( 50 )
      MsgStop( OemToAnsi( "Nombre de la Carpeta esta vac¡a... Use el Bot¢n [ Buscar Carpeta ] " ), EmpSoft )
      Return Nil
    EndIf

    SysRefresh()
    oText:SetText("  Comprobando Carpeta "+cCarp )

    FClose( FCreate( cCarp+"\Check.Ctr", 0 ) )
    SysRefresh()
    nTest := FError()

    IF nTest == 5
        MsgStop ( OemToAnsi( "El disco est  protegido contra escritura. Desprot‚jalo y reintente." ), EmpSoft )
    ELSEIF nTest > 0
        MsgStop ( OemToAnsi( "Carpeta no existe o fue borrado.  Por favor, compru‚belos." ), EmpSoft )
    ELSE  
        oText:SetText ("  Cerrando ficheros ")
        dbCloseAll()
        NumFiles := aDir ( cFile, Ficheros, Longitud)
        oText:SetText ("  Borrando ficheros antiguos")
        FOR i:=1 TO NumFiles
            IF (File ( cCarp+"\"+Ficheros[i]), FErase ( cCarp+"\"+Ficheros[i]), )
        NEXT
        FClose( FCreate( cCarp+"\Last.Ctr", 0 ) )

        FOR i:=1 TO NumFiles
          oText:SetText("  Copiando fichero "+Ficheros[i])
          __CopyFile (Ficheros[i], cCarp+"\"+Ficheros[i])
        NEXT

        oText:SetText( OemToAnsi( "  Copia finalizada con ‚xito ...") )
        MsgBeep()
        MsgInfo( OemToAnsi( "Copia terminada satisfactoriamente ..." ), EmpSoft )
    ENDIF

  EndIf

RETURN NIL

//----------------------------------------------------------------------------//
CiberSoft
servicomver
Posts: 159
Joined: Fri Nov 18, 2005 7:34 pm

Re: Copia de archivos

Post by servicomver »

Gracias por tu respuesta, explico un poco mas, necesito grabar archivos a una unidad en un ftp, pero quiciera ver la posibilidad de que se vaya indicando en pantalla el porcentaje de lo que se esta copiando, de cada uno de los archivos que paso, algo parcedito a la clase ftpsendfiles
User avatar
karinha
Posts: 4882
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Copia de archivos

Post by karinha »

Francis, podrias poner el .RC de dialogo "DlgCopiar"
???

Gracias.
João Santos - São Paulo - Brasil
User avatar
MarioG
Posts: 1356
Joined: Fri Oct 14, 2005 1:28 pm
Location: Resistencia - Chaco - AR

Re: Copia de archivos

Post by MarioG »

karina, una opción:

Code: Select all

   for nX:= 1 to nTotFiles
      hSource = FOpen( ::aFuenteHD[ nX ] )                  // aFuenteHD guarda camino+nombre de archivo
      oFileW = TFTPFile():New( ::aDestinoW[ nX ], ::oFTP )  // aDestinoW guarda camino en el FTP+nombre de archivo
      oFileW:OpenWrite()

      aO[_SFuente]:SetText( "Fuente: "  + ::aFuenteHD[ nX ] )     // muestro en el Dlg el camino+nombrearch
      aO[_SDestino]:SetText( "Destino: " + ::aDestinoW[ nX ] )    // idem 
      aO[_Meter1]:Set( 0 )                                        // pongo en 0 el meter
      aO[_Meter1]:nTotal = FSeek( hSource, 0, 2 )                 // asigno total del meter
      SysRefresh()

      FSeek( hSource, 0, 0 )
      nFile := 0

      // realizo el proceso de envio mostrando el avance en meter1= archivo actual - meter2= sumatoria de archivos
      while ( nBytes := FRead( hSource, @cBuffer, nBufSize ) ) > 0
         oFileW:Write( SubStr( cBuffer, 1, nBytes ) )
         aO[_SBytes]:SetText( "Bytes copiados: " + ;
                              AllTrim( Str( nTotal += nBytes ) ) )      // informa los bytes copiados
         aO[_Meter1]:Set( nFile += nBytes )
         aO[_Meter1]:Refresh()
         aO[_Meter2]:Set( nTotal )
         aO[_Meter2]:Refresh()
         SysRefresh()
      end
      FClose( hSource )
      oFileW:End()
      SysRefresh()
   next
Saludos
Resistencia - "Ciudad de las Esculturas"
Chaco - Argentina
User avatar
karinha
Posts: 4882
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Copia de archivos

Post by karinha »

MarioG wrote:karina, una opción:

Code: Select all

   for nX:= 1 to nTotFiles
      hSource = FOpen( ::aFuenteHD[ nX ] )                  // aFuenteHD guarda camino+nombre de archivo
      oFileW = TFTPFile():New( ::aDestinoW[ nX ], ::oFTP )  // aDestinoW guarda camino en el FTP+nombre de archivo
      oFileW:OpenWrite()

      aO[_SFuente]:SetText( "Fuente: "  + ::aFuenteHD[ nX ] )     // muestro en el Dlg el camino+nombrearch
      aO[_SDestino]:SetText( "Destino: " + ::aDestinoW[ nX ] )    // idem 
      aO[_Meter1]:Set( 0 )                                        // pongo en 0 el meter
      aO[_Meter1]:nTotal = FSeek( hSource, 0, 2 )                 // asigno total del meter
      SysRefresh()

      FSeek( hSource, 0, 0 )
      nFile := 0

      // realizo el proceso de envio mostrando el avance en meter1= archivo actual - meter2= sumatoria de archivos
      while ( nBytes := FRead( hSource, @cBuffer, nBufSize ) ) > 0
         oFileW:Write( SubStr( cBuffer, 1, nBytes ) )
         aO[_SBytes]:SetText( "Bytes copiados: " + ;
                              AllTrim( Str( nTotal += nBytes ) ) )      // informa los bytes copiados
         aO[_Meter1]:Set( nFile += nBytes )
         aO[_Meter1]:Refresh()
         aO[_Meter2]:Set( nTotal )
         aO[_Meter2]:Refresh()
         SysRefresh()
      end
      FClose( hSource )
      oFileW:End()
      SysRefresh()
   next
Saludos

Gracias MarioG, muy bueno.
João Santos - São Paulo - Brasil
FiveWiDi
Posts: 910
Joined: Mon Oct 10, 2005 2:38 pm

Re: Copia de archivos

Post by FiveWiDi »

servicomver wrote:Gracias por tu respuesta, explico un poco mas, necesito grabar archivos a una unidad en un ftp, pero quiciera ver la posibilidad de que se vaya indicando en pantalla el porcentaje de lo que se esta copiando, de cada uno de los archivos que paso, algo parcedito a la clase ftpsendfiles
Busa es estos foros mensajes de The Full; dejó un código que creo que será lo que necesitas.
(Supongo que allá por el 2009 ó 2010).

Él en su momento tuvo la necesidad de copiar archivos grandes y poder incluso abortar si lo deseaba.

EDITO:
Mira aquí -> http://forums.fivetechsupport.com/viewt ... ull#p74682

VUELVO A EDITAR: Dios ! Es del 2007 ! Cómo pasa el tiempo !

Saludos
Carlos G.
Un Saludo
Carlos G.

FiveWin 19.06 + Harbour 3.2, BCC 7 Windows 10
servicomver
Posts: 159
Joined: Fri Nov 18, 2005 7:34 pm

Re: Copia de archivos

Post by servicomver »

Hola a todos y gracias ya funciono gracias a sus ejemplos :D

Ya logre poner visible el porcentaje de copiado, pero requiero que el usuario no cancele o cierre la aplicacion, como puedo quitar la "X" del Dialog ?

algo asi como oDlg:lHelpicon:=.F.
User avatar
anserkk
Posts: 1280
Joined: Fri Jun 13, 2008 11:04 am
Location: Kochi, India

Re: Copia de archivos

Post by anserkk »

servicomver wrote:pero requiero que el usuario no cancele o cierre la aplicacion, como puedo quitar la "X" del Dialog ?
algo asi como oDlg:lHelpicon:=.F.

Code: Select all

nStyle :=nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION ) // Removes the ? and x on the dialogue title
DEFINE DIALOG oDlg FROM 10,20 to 27,90 TITLE "Login" STYLE nStyle 
 
Regards
Anser
Post Reply