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
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
//----------------------------------------------------------------------------//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
Francis, podrias poner el .RC de dialogo "DlgCopiar"
???
Gracias.
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()
nextMarioG wrote:karina, una opción:
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
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
Un Saludo
Carlos G.
FiveWin 25.12 + Harbour 3.2.0dev (r2502110321), BCC 7.7 Windows 11 Home
Hola a todos y gracias ya funciono gracias a sus ejemplos 
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.
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.
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