Retrouver l'icone de l'explorer associé à un fichier

Commenter

Contenu du snippet

C'est une classe qui dérive de la classe System.IO.FileSystemInfo, à laquelle j'ai ajouté les bénéfices d'une petite API qui me permet de retourver l'icone associé au fichier et qu'il doit s'afficher dans l'explorer.

Source / Exemple : 


Imports System.IO
Imports Microsoft.Win32
Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices

Public Class AdvancedFileSysInfo

    Inherits System.IO.FileSystemInfo

    ' Enumération des valeurs dispo pour le paramètre flag de SHGetFileInfo
    <Flags()> Private Enum SHGFI
        SmallIcon = &H1
        LargeIcon = &H0
        Icon = &H100
        DisplayName = &H200
        Typename = &H400
        SysIconIndex = &H4000
        UseFileAttributes = &H10
    End Enum

    Public Enum IconType
        SmallIcon = True
        LargeIcon = False
    End Enum

    ' Structure contenant les informations sur un objet du filesystem
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure SHFILEINFO
        Public hIcon As IntPtr
        Public iIcon As Integer
        Public dwAttributes As Integer
        <MarshalAs(UnmanagedType.LPStr, SizeConst:=260)> _
        Public szDisplayName As String
        <MarshalAs(UnmanagedType.LPStr, SizeConst:=80)> _
        Public szTypeName As String

        Public Sub New(ByVal B As Boolean)
            hIcon = IntPtr.Zero
            iIcon = 0
            dwAttributes = 0
            szDisplayName = vbNullString
            szTypeName = vbNullString
        End Sub
    End Structure
    
    ' Permet de retourver les informations sur un fichier, un répertoire, un disque 
    Private Declare Auto Function SHGetFileInfo Lib "shell32" ( _
     ByVal pszPath As String, ByVal dwFileAttributes As Integer, _
     ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlagsn As SHGFI) As Integer

    Public Overrides ReadOnly Property Name() As String
        Get
            Dim Info As New FileInfo(Me.OriginalPath)
            Name = Info.Name
            Info = Nothing
        End Get
    End Property

    Public Overrides Sub Delete()
        Dim Info As New FileInfo(Me.OriginalPath)
        Info.Delete()
        Info = Nothing
    End Sub

    Public Overrides ReadOnly Property Exists() As Boolean
        Get
            Dim Info As New FileInfo(Me.OriginalPath)
            Exists = Info.Exists
            Info = Nothing
        End Get
    End Property

    ' Cette propriété retourne un icone, celui affiché dans l'explorer
    Public ReadOnly Property AssociatedIcon(ByVal IconSize As IconType, Optional ByVal MustExist As Boolean = True) As Icon
        Get
            If MustExist Then
                If Me.Exists Then
                    Dim Info As New FileInfo(Me.OriginalPath)
                    AssociatedIcon = GetIcon(Info.Extension, IconSize)
                    Info = Nothing
                Else
                    AssociatedIcon = Nothing
                End If
            Else
                Dim Info As New FileInfo(Me.OriginalPath)
                AssociatedIcon = GetIcon(Info.Extension, IconSize)
                Info = Nothing
            End If
        End Get
    End Property

    ' Permet de récupérer l'icone du fichier tel qu'il apparait dans l'explorer
    Private Function GetIcon(ByVal Path As String, Optional ByVal Ico As IconType = True) As Icon
        Dim info As New SHFILEINFO(True)
        Dim cbSizeInfo As Integer = Marshal.SizeOf(info)
        Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes
        If Ico = True Then
            flags += SHGFI.SmallIcon
        Else
            flags += SHGFI.LargeIcon
        End If
        SHGetFileInfo(Path, 256, info, cbSizeInfo, flags)
        Return Icon.FromHandle(info.hIcon)
    End Function

    Private Function ExtractDefaultIcon() As String

        Dim HKROOT As Registry
        Dim hsubKey As RegistryKey
        Dim sApplication As String

        ExtractDefaultIcon = ""

        hsubKey = HKROOT.ClassesRoot.OpenSubKey(Me.Extension)

        If Not hsubKey Is Nothing Then

            sApplication = hsubKey.GetValue("")
            hsubKey.Close()
            hsubKey = HKROOT.ClassesRoot.OpenSubKey(sApplication & "\DefaultIcon")
            If Not hsubKey Is Nothing Then
                ExtractDefaultIcon = hsubKey.GetValue("")
                hsubKey.Close()
            End If
        End If

        hsubKey = Nothing
        HKROOT = Nothing
    End Function

    Public Sub New(ByVal FileName As String)
        Me.OriginalPath = FileName
    End Sub

End Class

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 (melkor18)