SHFileOperation

Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp as SHFILEOPSTRUCT) As Long
'Dove l'unico paramentro da passargli 'lpFileOp' e' una

'struttura SHFILEOPSTRUCT la quale conterra' tutti i dati

'necessari per compiere l'operazione scelta.

'La struttura SHFILEOPSTRUCT e' la seguente:

Private Type SHFILEOPSTRUCT
hwnd As Long 'E' l'handle della DialogBox usata
'per mostarare lo stato dell'operazione.

'Se il valore di fFlags e' settato a FOF_CREATEPROGRESSDLG,

'in hwnd si specifica l'handle della Form che visualizzera'

'la DialogBox.


wFunc As Long 'Specifica il tipo di operazione da compiere e puo essere
'una delle seguenti costanti:

'FO_COPY: Copia i files da pFrom a pTo

'FO_RENAME: Rinomina il file specificato in pFrom

'FO_DELETE: Cancella i files specificati in pFrom

'FO_MOVE: Muove i files da pFrom a pTo

pFrom As String 'Buffer contenente il nome (completo del paht) del file(s)
'sorgente. In caso di piu' files, ognuno deve essere

'separato da un carattere nullo. La fine del buffer deve

'essere indicata con due caratteri nulli consecutivi

pTo As String 'Buffer contenente il path di destinazione o il file(s) di
'destinazione. In caso in caso di piu' files, ognuno deve essere

'separato da un carattere nullo. La fine del buffer deve

'essere indicata con due caratteri nulli consecutivi. Possono

'essere specificate destinazioni multiple se il valore di

'fFlags e' FOF_MULTIDESTFILES.

fFlags As Integer 'Questo campo indica alla funzione il tipo di controllo da
'effettuare durante l'operazione. Puo' avere uno o piu' dei

'seguenti valori:

'FOF_ALLOWUNDO preserva le informazioni per un eventuale UNDO.

'FOF_CONFIRMMOUSE (non implementato).

'FOF_FILESONLY Migliora le prestazioni dell'operazione se viene

'specificata una wildcard per i files (*.*).

'FOF_MULTIDESTFILES Indica che in pTo sono specificate

'destinazioni multiple per i files.

'Praticamente per ogni file sorgente, e' specificato

'un file di destinazione

'FOF_NOCONFIRMATION Se la DialogBox non e' visibile, il sistema

'automaticamente risponde "Yes to all" alle domande.

'FOF_NOCONFIRMMKDIR Se c'e' bisogno di creare una nuova directory, il

'sistema non chiede conferma prima di crearla.

'FOF_RENAMEONCOLLISION Se nella directory di destinazione, esiste un

'file con un nome identico a un file sorgente,

'viene creato un nuovo file tipo "Copia #1 di ..."

'FOF_SILENT La DialogBox non e' visibile.

'FOF_SIMPLEPROGRESS La DialogBox e' visibile, ma non vengono

'visualizzati i nome dei files.

'FOF_CREATEPROGRESSDLG La DialogBox e' visibile, e vengono

'visualizzati i nome dei files.

'FOF_WANTMAPPINGHANDLE La funzione SHFileOperation riempe hNameMappings

'(leggere piu' avanti)

fAnyOperationsAborted As Boolean'Se l'operazione viene annullata prima del suo
'completamente, questo campo conterra' il valore

'TRUE

hNameMappings As Long'Questo campo, usato solo se fFlags include il valore
'FOF_WANTMAPPINGSHANDLE, contiene, al termine dell'operazione

'l'handle ad un oggetto filename mapping. Questo oggetto,

'a sua volta contiene un array di strutture SHNAMEMAPPING

'contenenti sia il vecchio che il nuovo path di ogni file

'copiato, mosso o rinominato

lpszProgressTitle As String'Quando in fFlags e' indicato il valore FOF_SIMPLEPROGRESS,
'questo campo punta ad una stringa contenente il titolo

'visualizzato nella DialogBox

End Type
'La funzione restituisce il valore 0 in caso di successo. In

'caso contrario viene restituito, un valore diverso da zero.

'********

' When researching this article,

' I discovered a bug in that the SHFileOperation returns

' a zero value regardless of the outcome of the file operation.

' To this end, the class in this article uses a DoesFileExist function

' to first determine that the source file actually exists.

' By using the DoesFileExist function, we can be assured that

' the SHFileOperation performs as

'********

'A questo punto basta inglobare quest'API in una routine

'Visual Basic, o meglio in una classe, per utilizzare le

'funzioni di SHFileOperation in maniera molto semplice

'e trasparente. Di seguito e' presentato il codice per la

'crezione della classe

'FileOperation:

'Creare un nuovo progetto ed inserirvi un nuovo modulo di

'classe rinominandolo clsOperazioniFiles;

'Copiare il seguente codice nel modulo clsOperazioniFiles

'********** INIZIO CODICE ****************

Option Explicit
'Dichiarazioni e costanti

Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Public Enum FlagOperazione
PERMETTI_UNDO = &H40 'FOF_ALLOWUNDO
NON_CHIEDE_CONFERMA = &H10 'FOF_NOCONFIRMATION
CREA_DIR_SENZA_CONFERMA = &H200 'FOF_NOCONFIRMMKDIR
RINOMINA_AUTOMATICAMENTE = &H8 'FOF_RENAMEONCOLLISION
NESSUNA_DIALOG = &H4 'FOF_SILENT
DIALOG_SEMPLICE = &H100 'FOF_SIMPLEPROGRESS
DIALOG_ESTESA = &H0 'FOF_CREATEPROGRESSDLG
End Enum
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Long
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'Metodo per la copia di files

Public Function ApiCopiaFiles( _
Handle As Long, _
Titolo As String, _
Destinazione As String, _
Flag As FlagOperazione, _
ParamArray FileOrigine() As Variant) As Long
'Attivo la gestione degli errori

On Error Resume Next
'Dichiaro le variabili locali

Dim Tmp As Integer
Dim FileStruct As SHFILEOPSTRUCT
Dim TmpString As String
'Creo la stringa da passare alla funziore API con l'elenco

'dei file da copiare

For Tmp = LBound(FileOrigine) To UBound(FileOrigine)
TmpString = TmpString & FileOrigine(Tmp) & vbNullChar
Next
TmpString = TmpString & vbNullChar

'riempio la struttura SHFILEOPSTRUCT...

FileStruct.hwnd = Handle
FileStruct.pFrom = TmpString
FileStruct.pTo = Destinazione
FileStruct.fFlags = Flag
FileStruct.wFunc = FO_COPY
FileStruct.lpszProgressTitle = Titolo
'... e la passo alla funzione API

ApiCopiaFiles = SHFileOperation(FileStruct)

'Se si e' verificato un errore

If ApiCopiaFiles <> 0 Then
'Visualizza l'errore riportato dalla chiamata alla dll

If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError
End If
End If
End Function

'Metodo per la cancellazione di files

Public Function ApiCancellaFiles( _
Handle As Long, _
Titolo As String, _
Flag As FlagOperazione, _
ParamArray FileOrigine() As Variant) As Variant
'Attivo la gestione degli errori

On Error Resume Next
'Dichiaro le variabili locali

Dim Tmp As Integer
Dim FileStruct As SHFILEOPSTRUCT
Dim TmpString As String
'Creo la stringa da passare alla funzione API con l'elenco

'dei file da cancellare

For Tmp = LBound(FileOrigine) To UBound(FileOrigine)
TmpString = TmpString & FileOrigine(Tmp) & vbNullChar
Next
TmpString = TmpString & vbNullChar

'riempio la struttura SHFILEOPSTRUCT...

FileStruct.hwnd = Handle
FileStruct.pFrom = TmpString
FileStruct.fFlags = Flag
FileStruct.wFunc = FO_DELETE
FileStruct.lpszProgressTitle = Titolo
'... e la passo alla funzione API

ApiCancellaFiles = SHFileOperation(FileStruct)

'Se si e' verificato un errore

If ApiCancellaFiles <> 0 Then
'Visualizza l'errore riportato dalla chiamata alla dll

If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError
End If
End If
End Function

'Metodo per lo spostamento di file

Public Function ApiSpostaFiles( _
Handle As Long, _
Titolo As String, _
FileDestinazione As String, _
Flag As FlagOperazione, _
FileOrigine As String) As Long
'Attivo la gestione degli errori

On Error Resume Next
'Dichiaro le variabili locali

Dim FileStruct As SHFILEOPSTRUCT

FileOrigine = FileOrigine & vbNullChar

'riempio la struttura SHFILEOPSTRUCT...

FileStruct.hwnd = Handle
FileStruct.pFrom = FileOrigine
FileStruct.pTo = FileDestinazione
FileStruct.fFlags = Flag
FileStruct.wFunc = FO_MOVE
FileStruct.lpszProgressTitle = Titolo
'... e la passo alla funzione API

ApiSpostaFiles = SHFileOperation(FileStruct)

'Se si e' verificato un errore

If ApiSpostaFiles <> 0 Then
'Visualizza l'errore riportato dalla chiamata alla dll

If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError
End If
End If
End Function

'Metodo per la rinomina di file

Public Function ApiRinominaFiles( _
Handle As Long, _
Titolo As String, _
FileDestinazione As String, _
Flag As FlagOperazione, _
FileOrigine As String) As Long
'Attivo la gestione degli errori

On Error Resume Next
'Dichiaro le variabili locali

Dim FileStruct As SHFILEOPSTRUCT

FileOrigine = FileOrigine & vbNullChar

'riempio la struttura SHFILEOPSTRUCT...

FileStruct.hwnd = Handle
FileStruct.pFrom = FileOrigine
FileStruct.pTo = FileDestinazione
FileStruct.fFlags = Flag
FileStruct.wFunc = FO_RENAME
FileStruct.lpszProgressTitle = Titolo
'... e la passo alla funzione API

ApiRinominaFiles = SHFileOperation(FileStruct)

'Se si e' verificato un errore

If ApiRinominaFiles <> 0 Then
'Visualizza l'errore riportato dalla chiamata alla dll

If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError
ApiRinominaFiles = -2 'Errore DLL
End If
End If
End Function

'******** TERMINE CODICE ***********

'Si raccomanda di verificare l'esistenza del percorso e dei

'files di origine, in quanto la SHFileOperation, in caso di

'mancanza dei files genera un'errore.

'A questo punto basta includere la classe clsOperazioniFiles

'in qualsiasi progetto per avere a disposizione le funzioni di

'copia, cancellazione, spostamento e rinomina files:

'Esempio per la copia di files

Dim FileClass As New clsOperazioniFiles
Dim RetValue As Long
RetValue = FileClass.ApiCopiaFiles(Me.hwnd, _
"Copia files in corso...", _
"C:\backup", _
DIALOG_ESTESA, _
"c:\dos\command.com", "c:\bootlog.txt")
'Esempio per la cancellazione di files mediante invio nel

'cestino;

Dim FileClass As New clsOperazioniFiles
Dim RetValue As Long
X = FileClass.ApiCancellaFiles(Me.hwnd, _
"Eliminazione files", _
DIALOG_ESTESA + PERMETTI_UNDO, _
"c:\gianluca\*.*")
'Esempio per lo spostamento di files;

Dim FileClass As New clsOperazioniFiles
Dim RetValue As Long
X = FileOp.ApiSpostaFiles(Me.hwnd, _
"Sposta...", _
"c:\tempBack", _
CREA_DIR_SENZA_CONFERMA + DIALOG_ESTESA, _
"c:\temp\*.*")
'Esempio per la rinomina di file;

Dim FileClass As New clsOperazioniFiles
Dim RetValue As Long
X = FileOp.ApiRinominaFiles(Me.hwnd, _
"Rinomina...", _
"c:\temp\prova.txt", _
NESSUNA_DIALOG, _
"c:\temp\prova.doc")
Esiste una funzione API nella DLL shell32.dll, chiamata
SHFileOperation, con la quale e' possibile effettuare diverse
operazioni sui files demandando tutto il lavoro piu' gravoso al
sistema operativo.
Con tale funzione API e possibile copiare, cancellare,
rinominare o muovere uno o piu' files.
Mentre viene effettuta l'operazione scelta, si puo far
visualizzare (opzionalmente) la DialogBox animata conosciuta
da tutti, la quale ci fornisce un riferimento sul progresso
dell'operazione.