Shfileoperation qui fonctionne enfin entièrement vb.net, y compris le flag d'annulation

Commenter

Contenu du snippet

Voici une source qui montre comment utiliser l'API Win32 "SHFileOperation" en VB.NET pur.

Beaucoup d'entre vous ont du constater qu'en VB6 la flag d'annulation fAnyOperationsAborted de la structure SHFILEOPSTRUCT n'était jamais positionné à True quand on annulait une copie par exemple.

Pour corriger ca, on utilisait une TypeLibrary (fichier .tlb), on l'ajoutait en référence au projet, pour garantir l'alignement en mémoire des membres de la structure SHFILEOPSTRUCT.

En VB.NET, si on déclare la structure SHFILEOPSTRUCT de manière habituelle, le problème est toujours le même. Pour garantir l'alignement en mémoire des membres de la structure, il faut utiliser StructureLayout de la manière suivante :

<StructLayout(LayoutKind.Explicit, CharSet:=CharSet.Ansi)> _
Public Structure SHFILEOPSTRUCT

<FieldOffset(0)> Public hWnd As Integer
<FieldOffset(4)> Public wFunc As Integer
<FieldOffset(8)> Public pFrom As String
<FieldOffset(12)> Public pTo As String
<FieldOffset(16)> Public fFlags As Short
<FieldOffset(18)> Public fAnyOperationsAborted As Boolean
<FieldOffset(20)> Public hNameMappings As Object
<FieldOffset(24)> Public lpszProgressTitle As String

End Structure

' version Ansi, correspond au StructLayout
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As long

Vous pouvez remplacer "Ansi" par Unicode, mais il faut alors adapter la déclaration de l'API :

' version Unicode
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationW" (ByRef lpFileOp As SHFILEOPSTRUCT) As long

L'inconvénient est qu'il faut indiquer "en dure" l'offset des champs dans la structure, qui dépend évidemment du type des champs, en espérant que leur taille sera toujours la même suivant la plateforme d'exécution.

CE QUI RESTE A FAIRE : rendre les paramètres FieldOffset dynamiques au moment de l'exécution...

Voici donc le code d'une classe VB.NET complète...

Christophe

Source / Exemple : 


Imports System.Runtime.InteropServices

Public Class ShFileOp

    Public Const FO_COPY As Short = &H2S
    Public Const FO_DELETE As Short = &H3S
    Public Const FO_MOVE As Short = &H1S
    Public Const FO_RENAME As Short = &H4S

    Public Const FOF_CONFIRMMOUSE As Short = &H2S
    Public Const FOF_ALLOWUNDO As Short = &H40S
    Public Const FOF_FILESONLY As Short = &H80S
    Public Const FOF_MULTIDESTFILES As Short = &H1S
    Public Const FOF_NOCONFIRMATION As Short = &H10S
    Public Const FOF_NOCONFIRMMKDIR As Short = &H200S
    Public Const FOF_NO_CONNECTED_ELEMENTS As Short = &H1000S
    Public Const FOF_NOCOPYSECURITYATTRIBS As Short = &H800S
    Public Const FOF_NOERRORUI As Short = &H400S
    Public Const FOF_RENAMEONCOLLISION As Short = &H8S
    Public Const FOF_SILENT As Short = &H4S
    Public Const FOF_SIMPLEPROGRESS As Short = &H100S
    Public Const FOF_WANTMAPPINGHANDLE As Short = &H20S
    Public Const FOF_WANTNUKEWARNING As Short = &H2000S
    Public Const FOF_NORECURSION As Short = &H1000S '// don't recurse into directories.

    <StructLayout(LayoutKind.Explicit, CharSet:=CharSet.Ansi)> _
    Public Structure SHFILEOPSTRUCT

        <FieldOffset(0)> Public hWnd As Integer
        <FieldOffset(4)> Public wFunc As Integer
        <FieldOffset(8)> Public pFrom As String
        <FieldOffset(12)> Public pTo As String
        <FieldOffset(16)> Public fFlags As Short
        <FieldOffset(18)> Public fAnyOperationsAborted As Boolean
        <FieldOffset(20)> Public hNameMappings As Object
        <FieldOffset(24)> Public lpszProgressTitle As String

    End Structure

    Private fos As SHFILEOPSTRUCT

    ' version Ansi, correspond au StructLayout
    Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As long

    Public Property Action() As short
        Get
            Return fos.wFunc
        End Get
        Set(ByVal Value As short)
            fos.wFunc = Value
        End Set
    End Property

    Public Property Source() As String
        Get
            Return fos.pFrom
        End Get
        Set(ByVal Value As String)
            fos.pFrom = Value
        End Set
    End Property

    Public Property Destination() As String
        Get
            Return fos.pTo
        End Get
        Set(ByVal Value As String)
            fos.pTo = Value
        End Set
    End Property

    Public Property Hwnd() As Integer
        Get
            Return fos.hWnd
        End Get
        Set(ByVal Value As Integer)
            fos.hWnd = Value
        End Set
    End Property

    Public Property Flags() As Short
        Get
            Return fos.fFlags
        End Get
        Set(ByVal Value As Short)
            fos.fFlags = Value
        End Set
    End Property

    Public ReadOnly Property AnyOperationsAborted() As Boolean
        Get
            Return fos.fAnyOperationsAborted
        End Get
    End Property

    Public ReadOnly Property NameMappings() As Integer
        Get
            Return fos.hNameMappings
        End Get
    End Property

    Public Property ProgressTitle() As String
        Get
            Return fos.lpszProgressTitle
        End Get
        Set(ByVal Value As String)
            fos.lpszProgressTitle = Value
        End Set
    End Property

    Public Function Operate() As long
        Dim retval As long

        retval = SHFileOperation(fos)

        Return retval
    End Function

    Public Sub New()

        With fos
            .hWnd = 0 'ou Me.hWnd si on a une Feuille par exemple
            .wFunc = -1
            .pFrom = Nothing
            .pTo = Nothing
            .fFlags = -1
            .lpszProgressTitle = vbNullChar
        End With

    End Sub
End Class

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Utilisation de la classe :

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim ret As Long
        Dim src, dst As String
        Dim fileop As New ShFileOp

        fileop.hWnd = 0
        fileop.Action = ShFileOp.FO_COPY
        src = "c:\program files" + vbNullChar + vbNullChar
        fileop.Source = src
        dst = "c:\temp" + vbNullChar + vbNullChar
        fileop.Destination = dst
        fileop.Flags = ShFileOp.FOF_NOCONFIRMATION Or ShFileOp.FOF_NOCONFIRMMKDIR

        ret = fileop.Operate

        If fileop.AnyOperationsAborted = True Then
            MsgBox("Copie interrompue")
        End If
    End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (chris_brabant)