1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Retrouver l'icone de l'explorer associé à un fichier

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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 258 fois - Téléchargée 36 fois

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

Ajouter un commentaire Commentaires
blq
Messages postés
97
Date d'inscription
vendredi 22 octobre 1999
Statut
Membre
Dernière intervention
13 juin 2016
 1
11 déc. 2010 à 23:26
Je suis pas un expert, mais n'est-il pas plus simple de faire :
thePictureBox.Image = System.Drawing.Icon.ExtractAssociatedIcon(theFile).ToBitmap()

Il y a peut-être des limites, mais cela fonctionne, du moins avec VB 2010 Express.
cs_magicgus
Messages postés
206
Date d'inscription
mardi 10 février 2004
Statut
Membre
Dernière intervention
14 septembre 2011
21 mars 2010 à 14:33
oups désolé je me suis trompé d'onglet dans fofox ;)
cs_magicgus
Messages postés
206
Date d'inscription
mardi 10 février 2004
Statut
Membre
Dernière intervention
14 septembre 2011
21 mars 2010 à 14:32
Salut, pareil que dockyf,

Dans ton programme ça marche mais étrangement quand je l'implémente dans un de mes projets, il me charge l'icone (avec la flèche pour les raccourcis) et non la miniature... Moi y'a n'a pas conprendre...
dockyf
Messages postés
10
Date d'inscription
mardi 22 juin 2004
Statut
Membre
Dernière intervention
11 décembre 2008
14 mai 2007 à 11:49
C'est bien le type de source que je recherche, mais je débute et je ne parviens pas à utiliser la classe.
Un peu d'aide serait le bienvenue.

Merci par avance.

FAB
cs_M51
Messages postés
63
Date d'inscription
dimanche 20 novembre 2005
Statut
Membre
Dernière intervention
10 août 2007
12 avril 2007 à 17:04
Pour info Julien voir le lien:
http://www.vbfrance.com/code.aspx?ID=41631
Afficher les 13 commentaires
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)