RETROUVER L'ICONE DE L'EXPLORER ASSOCIÉ À UN FICHIER

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