Menu "ouvrir avec"

Soyez le premier à donner votre avis sur cette source.

Vue 16 356 fois - Téléchargée 736 fois

Description

Ce code permet d'afficher le menu "Ouvrir avec" tel qu'il s'affiche lorsque vous faites un clique droit sur un fichier dans l'explorateur Windows.

Source / Exemple :


Public Class frmMain

    Private Sub btnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpen.Click
        Dim dlg As New OpenFileDialog
        If dlg.ShowDialog = Windows.Forms.DialogResult.OK Then
            txtfile.text = dlg.FileName
        End If
    End Sub

    Private Sub frmMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        If e.Button = Windows.Forms.MouseButtons.Right Then
            mnuOpenWith.Items.Clear()

            If txtFile.Text = "" Then

                ' Si aucun fichier n'a été choisi:
                mnuOpenWith.Items.Add("Il faut choisir un fichier...")

            Else
                ' Création du menu:

                ' L'ImageList à associer avec le menu
                Dim MenuIML As New ImageList
                MenuIML.ColorDepth = ColorDepth.Depth32Bit
                mnuOpenWith.ImageList = MenuIML

                ' Récupération des différente commandes
                Dim Commands As Generic.List(Of OpenWithItem) = GetOpenWithList(IO.Path.GetExtension(txtFile.Text))

                ' Création d'un élément du menu pour chaque commande
                For Each Command As OpenWithItem In Commands
                    ' Création de l'élément
                    Dim item As ToolStripItem = mnuOpenWith.Items.Add(Command.Name)
                    ' Mettre la commande dans le tag de l'élément
                    item.Tag = Command.DefaultCommand
                    ' Extraire puis définir l'icone associé à l'élément du menu
                    MenuIML.Images.Add(Command.Path, Drawing.Icon.ExtractAssociatedIcon(Command.Path))
                    item.ImageKey = Command.Path
                    ' Evénement Click de l'élément du menu
                    AddHandler item.Click, AddressOf ToolStripMenuItem_Click
                Next

                ' Ajouter un séparateur
                If mnuOpenWith.Items.Count > 0 Then mnuOpenWith.Items.Add("-")

                ' Ajouter l'élément "Choisir le programme..."
                Dim Choisir As ToolStripItem = mnuOpenWith.Items.Add("Choisir le programme...")
                Choisir.Tag = "rundll32.exe shell32.dll,OpenAs_RunDLL %1"
                AddHandler Choisir.Click, AddressOf ToolStripMenuItem_Click

            End If

            ' Afficher le menu
            mnuOpenWith.Show(Me, e.Location, ToolStripDropDownDirection.Default)

        End If

    End Sub

    Private Sub ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        ' Récupérer la commande
        Dim command As String = sender.tag
        ' Remplacer le %1 par le nom du fichier a ouvrir
        command = command.Replace("%1", txtFile.Text)
        ' Lancer la commande
        Shell(command, AppWinStyle.NormalFocus)
    End Sub

    Public Function GetOpenWithList(ByVal Extension As String) As Generic.List(Of OpenWithItem)
        Dim ExtKey, AppKey, ComKey As Microsoft.Win32.RegistryKey
        Dim res As New Generic.List(Of OpenWithItem)

        'Récupération des applications associées à l'extension
        ExtKey = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & Extension & "\OpenWithList")
        If ExtKey IsNot Nothing Then
            Dim Applis() As String = ExtKey.GetValueNames

            ' Pour chaque application...
            For Each Application As String In Applis
                Application = ExtKey.GetValue(Application)
                AppKey = Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("Applications\" & Application & "\shell")

                If AppKey IsNot Nothing Then
                    ' La clé de l'application existe, on veut donc ajouter cette aplication à la liste
                    Dim Item As New OpenWithItem

                    ' Récupération des différentes commandes
                    Dim Commandes() As String = AppKey.GetSubKeyNames
                    For Each CommandeName As String In Commandes
                        ComKey = Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("Applications\" & Application & "\shell\" & CommandeName & "\command")
                        Dim Command As String = ComKey.GetValue("")

                        ' %systemroot% est automatiquement remplacé par le chemin d'accès lors du GetValue() 

                        Item.Commands.Add(CommandeName.ToLower, Command)
                        ComKey.Close()
                    Next

                    ' Récupérer le chemin de l'application a partir d'une commande
                    Dim com As String = Item.DefaultCommand
                    Dim path As String = ""
                    If com.Length > 0 Then
                        ' Enlever le début non voulu
                        com = com.Substring(com.IndexOf(":") - 1)
                        ' Enlever les arguments
                        For i As Integer = 3 To com.Length - 1
                            If My.Computer.FileSystem.FileExists(com.Substring(0, i)) Then
                                path = com.Substring(0, i).Trim
                                Item.Path = GetLongFilename(path)
                            End If
                        Next
                    End If

                    ' On remplace les noms de dossiers/fichiers court par les noms longs (dans les commandes)
                    If Item.Path <> path Then
                        Dim keys(Item.Commands.Count - 1) As String
                        Item.Commands.Keys.CopyTo(keys, 0)
                        For Each key As String In keys
                            If Item.Commands(key).Contains(path) Then _
                                Item.Commands(key) = Item.Commands(key).Replace(path, Item.Path)
                        Next
                    End If

                    ' Récupérer le nom de l'appli
                    If Item.Path.Length > 0 Then
                        Dim FileInfo As FileVersionInfo = FileVersionInfo.GetVersionInfo(Item.Path)
                        Item.Name = FileInfo.FileDescription
                    End If

                    res.Add(Item)
                    AppKey.Close()

                End If
            Next
            ExtKey.Close()
        End If
        Return res
    End Function

    Public Function GetLongFilename(ByVal ShortName As String) As String
        Dim LongName As String = ""

        ' Add \ to short name to prevent Instr from failing
        ShortName = ShortName & "\"
        ' Start from 4 to ignore the "[Drive Letter]:\" characters
        Dim SlashPos As Integer = InStr(4, ShortName, "\")
        ' Pull out each string between \ character for conversion
        Do While SlashPos
            Dim Temp As String = Dir(ShortName.Substring(0, SlashPos - 1), vbNormal Or vbHidden Or vbSystem Or vbDirectory)
            If Temp = "" Then
                ' Error 52 - Bad File Name or Number
                GetLongFilename = ""
                Exit Function
            End If
            LongName = LongName & "\" & Temp
            SlashPos = InStr(SlashPos + 1, ShortName, "\")
        Loop
        ' Prefix with the drive letter
        Return ShortName.Substring(0, 2) & LongName
    End Function

    Public Class OpenWithItem

        ' Toutes les commandes disponibles
        Private _Commands As New Generic.Dictionary(Of String, String)
        Public ReadOnly Property Commands() As Generic.Dictionary(Of String, String)
            Get
                Return _Commands
            End Get
        End Property

        ' La commande par défaut (d'après moi)
        Public ReadOnly Property DefaultCommand() As String
            Get
                If Commands.Count > 0 Then
                    If Commands.ContainsKey("open") Then
                        Return Commands("open")
                    ElseIf Commands.ContainsKey("play") Then
                        Return Commands("play")
                    ElseIf Commands.ContainsKey("read") Then
                        Return Commands("read")
                    ElseIf Commands.ContainsKey("edit") Then
                        Return Commands("edit")
                    Else
                        ' Si aucune des commande ci-dessus n'existent, prendre la 1ere qui est disponible
                        Dim enumerator As Generic.Dictionary(Of String, String).Enumerator = Commands.GetEnumerator()
                        Return enumerator.Current.Value
                    End If
                Else
                    Return ""
                End If
            End Get
        End Property

        ' Le chemin de l'application
        Private _Path As String
        Public Property Path() As String
            Get
                Return _Path
            End Get
            Set(ByVal value As String)
                _Path = value
            End Set
        End Property

        ' Le nom à afficher
        Private _Name As String
        Public Property Name() As String
            Get
                Return _Name
            End Get
            Set(ByVal value As String)
                _Name = value
            End Set
        End Property

    End Class

End Class

Conclusion :


Pour le code qui permet de retrouver les commandes shell du menu "Ouvrir avec" associées à un fichier, je me suis inspiré de plusieurs sources ou tutoriels trouvé sur le net, mais principalement d'un code trouvé sur VB France et déposé par loskiller62 disponible ici: http://www.vbfrance.com/codes/RECUPERATION-APPLICATIONS-OUVRIR-AVEC-FICHIER-EXTENSION_32446.aspx

Le code permettant de transformer les noms de dossiers et de fichiers court en noms longs n'est pas de moi, mais je en me souviens pas ou je l'ai trouvé (qq part sur Google ^^)

Il n'y a aucun bug connu, mais une partie du code ne me plait pas car elle n'est absolument pas performante, c'est la partie qui permet d'extraire le chemin d'accès du fichier à partir du code:

' Récupérer le chemin de l'application a partir d'une commande
Dim com As String = Item.DefaultCommand
Dim path As String = ""
If com.Length > 0 Then
' Enlever le début non voulu
com = com.Substring(com.IndexOf(":") - 1)
' Enlever les arguments
For i As Integer = 3 To com.Length - 1
If My.Computer.FileSystem.FileExists(com.Substring(0, i)) Then
path = com.Substring(0, i).Trim
Item.Path = GetLongFilename(path)
End If
Next
End If

Pour enlever les arguments de la commande, je fais une boucle qui à chaque itération ajoute un caractère de la commande et fait un test File.Exist. La dernière chaine qui retourne File.Exist = True est la ligne de commande du fichier. Le problème c'est donc qu'on fait le test File.Exist des dizaines de fois pour chaque commande, ce qui a mon avis (je n'ai pas testé le temps que ca prenait) ralentis un peu l'affichage du menu (c'est minime, et il y a aussi le ExtractIcon qui prend du temps).
Donc si qqun à une solution plus performante pour faire ça, n'hésitez pas à la partager ;)

Je post ce code après avoir demandé de l'aide sur le forum ici: http://www.vbfrance.com/infomsg_MENU-OUVRIR-AVEC_982685.aspx#4

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Children
Messages postés
84
Date d'inscription
lundi 5 février 2007
Statut
Membre
Dernière intervention
29 avril 2009
-
Je ne l'ai pas tester, mais s'il il marche,je dit bravo!! Je ne suis que débutant, doncpour moi cette source à l'air parfaite. Mais je le reète, je ne l'ai pas essayer.
cs_Warny
Messages postés
478
Date d'inscription
mercredi 7 août 2002
Statut
Membre
Dernière intervention
10 juin 2015
-
Pour le test du nom du fichier, tu peux aller nettement plus vite en découpant selon les espaces et en rajoutant les chaînes une par une.
Il doit y avoir une autre solution, mais je ne l'ai pas en tête.
Kevin.Ory
Messages postés
843
Date d'inscription
mercredi 22 octobre 2003
Statut
Membre
Dernière intervention
7 janvier 2009
4 -
Ouais effectivement Warny. En fait j'avais déjà modifié mon code dans ce sens ;) Mais merci pour la suggestion....

Et merci à toi aussi, Children :)

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.