Menu "ouvrir avec"
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.
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
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
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.