Registre - associer une action au clic droit de la souris

Commenter

Contenu du snippet

registre - associer une action au clic droit de la souris

Afficher / modifier / Créer les associations au clic droit de la souris.
Ne supporte que les associations shell (pas les Mine et autres)
Merci VB de supporter directement l'accès à la base de registre sans passer par les API.
Cette partie du registre est utilisable directement sans reboot

exemple, associer le lancement d'un éditeur d'icônes aux fichiers ".ico"

Source / Exemple : 


Imports Microsoft.Win32
Public Class Form1
    Private Sub vide()
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""
        ListBox2.Items.Clear()
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Key As RegistryKey
        Dim val As String()
        Dim i As Integer
        Key = Registry.ClassesRoot 'place l'indexe du parcourt du registre sur la clef HK_classes_root
        val = Key.GetSubKeyNames() ' rempli le tableau de chaines avec les valeur des sous-clefs
        For i = 0 To val.Count - 1
            'If Microsoft.VisualBasic.Left(val(i), 1) = "." Then ListBox1.Items.Add(Strings.Right(val(i), Len(i) - 1))
            ' essai pour enlever le. devant les noms d'extension
            If Microsoft.VisualBasic.Left(val(i), 1) = "." Then ListBox1.Items.Add(val(i))
            'met dans la liste les éléments commençant par "."
        Next i
        Key.Close()
        Button1.Text = ListBox1.Items.Count & " extensions .xyz"
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' mises de quelques couleurs via code
        GroupBox2.BackColor = Color.FromArgb(200, 200, 250)
        TextBox1.BackColor = Color.FromArgb(200, 240, 200)
        TextBox2.BackColor = Color.FromArgb(200, 240, 200)
        TextBox3.BackColor = Color.FromArgb(200, 240, 200)
        Button1.ForeColor = Color.FromArgb(100, 140, 100)
        TextBox4.BackColor = Color.FromArgb(200, 200, 250)
        TextBox5.BackColor = Color.FromArgb(200, 200, 250)
        GroupBox1.BackColor = Color.FromArgb(230, 170, 170)
        Button3.BackColor = System.Drawing.SystemColors.Control
        Button2.BackColor = System.Drawing.SystemColors.Control

    End Sub

    Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        TextBox1.Text = ListBox1.SelectedItem
        Dim Key, key2 As RegistryKey
        Dim val As String()
        Dim i As Integer
        ' nettoyage de l'affichage
        vide()
        ' va chercher la sous clef correspondante à l'élément cliqué
        Key = Registry.ClassesRoot.OpenSubKey(ListBox1.SelectedItem)

        If Not Key.GetValue("") = "" Then
            TextBox1.Text = Key.GetValue("")
            TextBox6.Text = TextBox1.Text
            ' la valeur "" , c'est la valeur par défaut
            ' ex : .ico - icone
            ' .ico, c'est dans la liste
            ' icone, la valeur par défaut, comme c'est multilangue, icone est aussi une clef
            ' cette clef a de nouveau une valeur par défaut qui est le nom 'icone' traduit dans la langue
            ' puis uune sous clef shell
            ' dans shell, une liste de sous clef pour différentes façons d'ouvrir par clic droit
            ' à chaque façon d'ouvrir, une sous clef open avec une ligne de commande à lancer
            Try
                ' si la sous clef n'est pas vide, on va chercher la valeur par défaut pointée par cette clef
                key2 = Registry.ClassesRoot.OpenSubKey(Registry.ClassesRoot.OpenSubKey(ListBox1.SelectedItem).GetValue(""))
                TextBox2.Text = key2.GetValue("")
                TextBox7.Text = TextBox2.Text
                'ensuite on regard son nom traduit 
                key2 = Registry.ClassesRoot.OpenSubKey(Key.GetValue(""))
                ' la valeur par défaut du clic droit
                TextBox3.Text = key2.OpenSubKey("shell").GetValue("")
                key2 = Registry.ClassesRoot.OpenSubKey(Key.GetValue("") & "\shell")
                ' la liste des actions par clic droit
                val = key2.GetSubKeyNames()
                'on passe le tableau de strings dans la liste box
                For i = 0 To val.Count - 1
                    ListBox2.Items.Add(val(i))
                Next i
                Key.Close()
            Catch
            End Try
        Else
            ' en cas d'extension sans association par clic droit
            TextBox1.Text = "association inexistante"
            TextBox2.Text = "n/a"
        End If

    End Sub

    Private Sub TextBox3_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged

    End Sub

    Private Sub Label3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label3.Click

    End Sub

    Private Sub ListBox2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox2.SelectedIndexChanged

        Dim key2 As Object
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""
        TextBox10.Text = ListBox2.SelectedItem
        Try
            key2 = Registry.ClassesRoot.OpenSubKey(TextBox1.Text & "\shell\" & ListBox2.SelectedItem)
            TextBox4.Text = key2.GetValue("")
            TextBox8.Text = TextBox4.Text
            key2 = Registry.ClassesRoot.OpenSubKey(TextBox1.Text & "\shell\" & ListBox2.SelectedItem & "\command")
            TextBox5.Text = key2.GetValue("")
            TextBox9.Text = TextBox5.Text

        Catch
            ' l'ajout d'un try/catch permet d'éviter les plantages avec les clefs inexistantes
        End Try

    End Sub

    Private Sub TextBox5_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox5.TextChanged

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ' si les champs principaux sont vide, on ne fait rien
        If TextBox6.Text = "" Or TextBox9.Text = "" Or TextBox10.Text = "" Then Exit Sub
        Dim confir = MsgBox("Anulation impossible, êtes-vous sûre ?", MsgBoxStyle.YesNoCancel, "Confirmation")
        If confir = MsgBoxResult.Yes Then
            Dim Key As RegistryKey
            Try
                Key = Registry.ClassesRoot.OpenSubKey(ListBox1.SelectedItem, True)
                ' true permer d'ouvrir la clef en écriture
                Key.SetValue("", TextBox6.Text)
                Key.Close()
                Key = Registry.ClassesRoot.CreateSubKey(TextBox6.Text)
                Key.Close()
                Key = Registry.ClassesRoot.OpenSubKey(TextBox6.Text, True)
                Key.SetValue("", TextBox7.Text)
                Key.CreateSubKey("shell")
                Key.Close()
                Key = Registry.ClassesRoot.OpenSubKey(TextBox6.Text & "\shell", True)
                Key.CreateSubKey(TextBox10.Text)
                If CheckBox1.Checked Then
                    Key.SetValue("", TextBox10.Text)
                End If
                Key.Close()
                Key = Registry.ClassesRoot.OpenSubKey(TextBox6.Text & "\shell\" & TextBox10.Text, True)
                Key.CreateSubKey("command")
                Key.Close()
                Key = Registry.ClassesRoot.OpenSubKey(TextBox6.Text & "\shell\" & TextBox10.Text & "\command", True)
                Key.SetValue("", TextBox9.Text)
                Key.Close()

            Catch
                ' l'ajout d'un try/catch permet d'éviter les plantages avec les clefs inexistantes
            End Try
        End If
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        bx.Title = "choisissez un fichier"
        bx.Filter = "Tous | *.*"
        bx.FilterIndex = 1
        bx.InitialDirectory = System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)
        bx.ShowDialog()
        TextBox9.Text = bx.FileName & " " & """" & "%1" & """"
    End Sub

    Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk

    End Sub
End Class

Conclusion :


j'essaierai de pousser un peu plus le mode lecture pour les associations de type "mine"

A voir également

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 (pascal16m)