Copiar, Mover y Eliminar ficheros usando el API de Windows (SHFileOperation)

 

Publicado: 11/May/99
Actualizado: 26/May/2004


Aunque ya hay un peque�o ejemplo en la segunda entrega del API, he creado un nuevo ejemplo con estas tres operaciones b�sicas, usando la misma funci�n que usa el Windows.
Lo he probado en Windows 98, pero me imagino que en Windows 95 tambi�n funcionar�, aunque en NT no lo he comprobado... si lo haces, me lo comunicas. Gracias. (* ver nota del 26/May/2004)

Seg�n las opciones que se especifiquen, ver el listado, Windows nos pedir� confirmaci�n o no, nos avisar� si tiene que crear el directorio de destino e incluso har� una copia si el fichero de destino ya existe.

En este ejemplo s�lo se manipula un fichero, para especificar varios ficheros, hay que separar cada nombre con vbvNullChar, ver el ejemplo de enviar ficheros a la papelera de reciclaje, para una funci�n que acepta varios nombres de ficheros en el par�metro.

Aqu� tienes una captura del form, en tiempo de dise�o y el listado, creo que no necesita m�s comentarios... espero que te sea de utilidad.

Nos vemos.
Guillermo

Nota del 26/Mayo/2004:
La declaraci�n de fFlags del tipo SHFILEOPSTRUCT la he cambiado a Long ya que fallaba en Windows XP. Us�ndola como Long tambi�n funciona en Windows 98.

Tambi�n he a�adido un zip con el c�digo y el ejecutable para VB6 SP5 (SHCopiar.zip 8.74 KB)


sh.gif (9243 bytes)

 

'------------------------------------------------------------------------------
' Ejemplo de copiar y mover ficheros usando el API de Windows       (11/May/99)
'
' Revisado y corregido para Windows XP Profesional                  (26/May/04)
' En el XP (y seguramente en Windows 2000) la variable fFlags es un Long
' Nota:
'   Esta revisi�n se la "debo" a un bug reportado por Juli�n Collado Angulo
'
' �Guillermo 'guille' Som, 1999, 2004
'------------------------------------------------------------------------------
Option Explicit

' Variables para el programa de prueba
Private sFicOri As String
Private sFicDes As String
Private iFlags As Long
' Constantes para el orden de los chkOpciones
Private Enum eOpciones
    cFOF_ALLOWUNDO
    cFOF_FILESONLY
    cFOF_MULTIDESTFILES
    cFOF_NOCONFIRMATION
    cFOF_NOCONFIRMMKDIR
    cFOF_RENAMEONCOLLISION
    cFOF_SILENT
    cFOF_SIMPLEPROGRESS
End Enum

' Variables, constantes y declaraciones para el API
Private Type SHFILEOPSTRUCT
    hWnd As Long                        ' hWnd del formulario
    wFunc As Long                       ' Funci�n a usar: FO_COPY, etc.
    pFrom As String                     ' Fichero(s) de origen
    pTo As String                       ' Fichero(s) de destino
    ' fFlags    para Windows 2000/XP declararlo como Long
    '           para Windows 9x declararlo como Integer,
    '           aunque tambi�n funciona si se declara como Long (al menos en W98)
    'fFlags As Integer                   ' Opciones
    fFlags As Long
    fAnyOperationsAborted As Boolean    ' Si se ha cancelado
    hNameMappings As Long               '
    lpszProgressTitle As String         ' S�lo si se usa FOF_SIMPLEPROGRESS
End Type

' Constantes para FileOperation
Private Enum eFO
    FO_COPY = &H2&                      ' Copiar
    FO_DELETE = &H3&                    ' Borrar
    FO_MOVE = &H1&                      ' Mover
    FO_RENAME = &H4&                    ' Renombrar
    '
    FOF_MULTIDESTFILES = &H1&           ' Multiples archivos de destino
    FOF_CONFIRMMOUSE = &H2&             ' No est� implementada
    FOF_SILENT = &H4&                   ' No mostrar el progreso
    FOF_RENAMEONCOLLISION = &H8&        ' Cambiar el nombre si el archivo de destino ya existe
    FOF_NOCONFIRMATION = &H10&          ' No pedir confirmaci�n
    FOF_WANTMAPPINGHANDLE = &H20&       '// Fill in SHFILEOPSTRUCT.hNameMappings
                                        '// Must be freed using SHFreeNameMappings
    FOF_ALLOWUNDO = &H40&               ' Permitir deshacer
    FOF_FILESONLY = &H80&               ' Si se especifica *.*, hacerlo s�lo con archivos
    FOF_SIMPLEPROGRESS = &H100&         ' No mostrar los nombres de los archivos
    FOF_NOCONFIRMMKDIR = &H200&         ' No confirmar la creaci�n de directorios
    FOF_NOERRORUI = &H400&              '// don't put up error UI
    FOF_NOCOPYSECURITYATTRIBS = &H800&  '// don't copy NT file Security Attributes
End Enum

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
    (lpFileOp As SHFILEOPSTRUCT) As Long

Private Sub cmdCopiar_Click()
    ' Copiar
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicOri = txtOri & vbNullChar & vbNullChar
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_COPY
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicOri
        .pTo = sFicDes
        .lpszProgressTitle = "Copiando los ficheros especificados"
    End With
    
    Call SHFileOperation(SHFileOp)
End Sub

Private Sub cmdEliminar_Click()
    ' Eliminar
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_DELETE
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicDes
        .lpszProgressTitle = "Eliminando el fichero especificado"
    End With
    
    Call SHFileOperation(SHFileOp)
End Sub

Private Sub cmdMover_Click()
    ' Mover
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicOri = txtOri & vbNullChar & vbNullChar
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_MOVE
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicOri
        .pTo = sFicDes
        .lpszProgressTitle = "Moviendo los ficheros especificados"
    End With
    
    Call SHFileOperation(SHFileOp)

End Sub

Private Sub Form_Load()
    Dim i As Long
    
    sFicOri = App.Path & "\Prueba.txt"
    sFicDes = App.Path & "\Temporal\Prueba.txt"
    
    txtOri = sFicOri
    txtDes = sFicDes
    
    ' Crear el fichero de prueba.txt
    i = FreeFile
    Open sFicOri For Output As i
    Print #i, "Fichero de prueba"
    Close
    '
End Sub

Private Sub AsignarFlags()
    ' Ajusta el valor del flag, seg�n las opciones seleccionadas
    iFlags = 0
    If chkOpciones(cFOF_ALLOWUNDO) Then _
        iFlags = iFlags + FOF_ALLOWUNDO
    
    If chkOpciones(cFOF_FILESONLY) Then _
        iFlags = iFlags + FOF_FILESONLY
    
    If chkOpciones(cFOF_MULTIDESTFILES) Then _
        iFlags = iFlags + FOF_MULTIDESTFILES
    
    If chkOpciones(cFOF_NOCONFIRMATION) Then _
        iFlags = iFlags + FOF_NOCONFIRMATION
    
    If chkOpciones(cFOF_NOCONFIRMMKDIR) Then _
        iFlags = iFlags + FOF_NOCONFIRMMKDIR
    
    If chkOpciones(cFOF_RENAMEONCOLLISION) Then _
        iFlags = iFlags + FOF_RENAMEONCOLLISION
    
    If chkOpciones(cFOF_SILENT) Then _
        iFlags = iFlags + FOF_SILENT
    
    If chkOpciones(cFOF_SIMPLEPROGRESS) Then _
        iFlags = iFlags + FOF_SIMPLEPROGRESS
End Sub

 

 


la Luna del Guille o... el Guille que está en la Luna... tanto monta...