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)
'------------------------------------------------------------------------------
' 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
