Usando a caixa de diálogo de Cópia de Arquivos do Explorer


Vamos mostrar como podemos realizar copias de arquivos e diretórios e exibir a caixa de diálogo usada pelo Explorer nas operações de cópias de arquivos. Se você não lembra a caixa é a seguinte:

Vamos ao projeto:

1- Inicie um novo projeto no VB e insira um módulo no seu projeto. Neste módulo inclua o seguinte código. (não esqueça de salvar o módulo)::

Seção General Declarations:

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

Public Declare Sub SHFreeNameMappings Lib _
"shell32.dll" (ByVal hNameMappings As Long)

Public Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
As Any, ByVal cbCopy As Long)

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
End Type

Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum

Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum

Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type

A seguir inclua a seguinte função no seu módulo:

Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte

lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) 'the size of the structure.

Call CopyMemory(foBuf(1), lpFileOp, lenFileop)

Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))

SHFileOP = result
End Function

No formulário do seu projeto inclua dois controles Labels (Origem e Destino) , dois controles TextBox (txtorigem e txtdestino) e um botão de comando. A aparência do formulário deve ser a seguinte:

projeto para copia usando a caixa de dialogo do Explorer

Na seção general Declarations do formulário declare as variáveis:

Dim lret As Long
Dim fileop As SHFILEOPSTRUCT

No evento Click do botão de comando - Iniciar Copia - insira o seguinte código :

Private Sub Command1_Click()

With fileop
  .hwnd = 0
  
  .wFunc = FO_COPY
  
  .pFrom = txtorigem & vbNullChar & vbNullChar
  
  .pTo = Txtdestino.Text & vbNullChar & vbNullChar
  
  .lpszProgressTitle = "Aguarde, realizando copia..."
  
  .fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION

End With

lret = SHFileOP(fileop)

If result <> 0 Then 'a operaçao falhou
   MsgBox Err.LastDllError 'exibe o erro retornado pela API
Else
  If fileop.fAnyOperationsAborted <> 0 Then
     MsgBox "Operação falhou !!!"
  End If
End If

End Sub

O projeto funciona assim: Voce informa o diretório de origem e os arquivos que deseja copiar e o destino da cópia , a seguir clica no botão - Iniciar Cópia. Vamos fazer uma copia de todos os arquivos presentes no diretório c:\teste para o diretório c:\jcm (que ainda não existe.) Ao clicar no botão de comando iremos obter o seguinte:

Aviso do sistema Inicio da copia com exibição da caixa de diálogo

Interessante !!! Não é mesmo ? Até breve...