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...