MENU "OUVRIR AVEC"

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

Télécharger le zip