EXÉCUTER UN PROGRAMME AVEC UN NIVEAU DE PRIVILÈGE ÉLEVÉ SUR VISTA EN VB.NET

Commentaire de ronanry le 02/01/2009 19:48:06

euh...c'est moi ou c'est une MEGA faille ???
a moins que l'utilisateur qui lance l'application soit obligé d'être administrateur?

Commentaire de Londonic le 10/02/2009 15:44:19

J'apprécie la clarté de ce tutorial, Merci.
Qui saurait résoudre une UnauthorizedAccessException dans un programme Basic ?
Ca tombe dans le SousMenuToolStripMenuItem_Click de la Classe Configuration mon module config.
ci-joint le commentaire, mes ambitions et les 2 sources de l'assembly.

Le premier source est un Visual asssembly Form1 de type Form avec un bouton.

Friend Class Form1

    Dim Intitialisation As New Configuration

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Intitialisation.Show()
    End Sub

End Class

Le second source est le module (config)

Le texte:

Le Projet Bourse vise à classer des informations dans des sous-dossiers de l'ordinateur. Les informations sont pêchées dans le Flux internet.

Un dossier est consacré aux données de l'application .
La configuratrice initialise un fichier de configuration et mémorise sa position dans le registre de Windows( L'adresse URL du dossier de configuration).
Le répertoire de ce fichier servira de racine aux données de l'application pour éviter d'encombrer le registre.

Un sous-Dossier "Config" est consacré au script de nettoyage du registre et à l'ancêtre de l'objet qui gère le flux des paramètres de configuration.
Les sites sont référencés dans le sous-Dossier Communication/Réseau (Objet favoris)
L'index du nasdaq dans le dossier Cotations/Indices/US/

A l'exception des entrées de l'utilisateur, qui sont prioritaires, et traitées immédiatement, les échéances seront planifiées dans le module Chronos chargé de veiller aussi aux multitâches.

7 Février
Les Opérations sur le registre sont intégrées aux fonctions de la configuratrice.
La configuratrice est équipée d'un pupitre.

10 Février 2009 Le programme propose une page Blanche (Form1) et un module qui gère les paramètres de configuration (show) et crée un dossier de configuration.(config). Ca fait deux fichiers sources dans la solution en plus d'une page blanche de design: Form1.
La configuration gère les inter-actions d'une Instance configuratrice d'objet initialisateur avec un pupitre.
L'opérateur selectionne le répertoire. Un dossier d'application est créé si besoin au démarrage.
L'initialisateur Charge un fichier de configuration à patir des informations du registre pour connaitre l'attribut caché du dossier des données de l'applications. En cas de dilemme, il propose un dossier qu'il crée si besoin, et Il met le registre à jour. Pour éviter d'emcombrer ce registre, Il n'inscrit que le chemin du dossier d'application. Il enregistre aussi un script.reg dans le dossier de l'application pour permettre de vider le chemin du registre avec l'explorateur.
Dans le cas où le dossier des données de l'application n'est pas inscrit au registre des softwares de l'utilisateur ([-HKEY_CURRENT_USER\Software\BASIC_9" & "\" & Nom & "]"; Nom est le rename utilisateur et non pas l'assembly) où que le Programme ne trouve pas de dossier à son nom dans le répertoire de son éxécutable, Il ouvre une fenêtre de dialogue priant l'utilisateur de confirmer la création de ce dossier. On peut choisir le dossier qu'on veut dans La fenêtre de dialogue et en ajouter. Bien que l'explorateur Windows fonctionne simultanément, il vaut mieux refermer la fenêtre de dialogue poursupprimmer des dossiers, car, compte tenu de la difficulté à vérifier si l'utilisateur a utilisé un bouton de sa souris en dehors de la zone de la fenêtre active du système Windows.Net, je ne peux garantir une inter-activité parfaite. Dans le cas où l'usage ferait sentir le besoin, On pourrait ajouter un bouton "corbeille". Pour la même raison, la création de sous-dossier a été limité au premier degré, et l'usage de l'explorateur sera utile a développer de grandes arborescences au préalable.
Le drapeau d'attribut caché du dossier Principal de l'application  est levé.
Aussitot que la position du dossier est confirmée, Le dossier est créé avec un attribut caché, et un fichier de configuration est enregistré, ainsi qu'un script pour effacer sa position dans le registre: Le chemin d'accès au dossier de l'application est La seule information enregistrée dans la base de données de Windows pour faciliter sa maintenance.
Si Il y a une cle mais que le chemin indiqué par cette clef ne correspond à rien.
On Choisit un dossier dans la fenêtre de confirmation. La valeur est remplacé dans le registre.
Le pupitre reste à l'état d'ébauche pour une question d'UnauthorizedAccessException qui a encore trouvé un moyen de s'imposer. A moins que Microsoft ne consacre plus de progès aux aspects de sa logique qu'à l'ergonomie et la sécurité, on attendra la prochaine cuvée de système IBM où un Kylix mieux orienté pour finir le traitement initial.
Ce pupitre serait bien pratique pour vérifier le bon fonctionnement de tous les algorythmes sans devoir sans cesse chercher la fenêtre du regedit, du dossier racine de celui de l'application, et le dossier de l'application lui-même, sans compter maintes douloureuses manoeuvres d'actualisation.

Le module Config:



Imports Microsoft.Win32

Module Config

    Sub Elevation_Privilege_Prgm(ByVal Prog As String, Optional ByVal arg As String = "")

        ' Vérifie si l'application est exécuté en tant qu'administrateur
        ' Ce qui revient au même de vérifier si le compte est Administrateur
        ' car seul un compte Administrateur peut exécuter une application en
        ' tant qu'administrateur
        If My.User.IsInRole(ApplicationServices.BuiltInRole.Administrator) Then

            Dim Pr As New Process

            If My.Computer.FileSystem.FileExists(Prog) = False Then
                MsgBox("Désolé, le chemin d'accès du programme que vous souhaitez lancer n'existe pas !!!")
                Exit Sub
            End If

            Pr.StartInfo.FileName = Prog
            Pr.StartInfo.Arguments = arg
            Pr.StartInfo.UseShellExecute = False
            Pr.StartInfo.Verb = "runas"
            Pr.Start()
        Else
            MsgBox("L'application doit être exécutée en tant qu'administrateur")
        End If

    End Sub

    '#Region "Configuration"

    ''' <summary>
    ''' Panneau de configuration
    ''' </summary>
    ''' <remarks></remarks>
    '''
    Friend Class Configuration

        Dim Configuratrice As New Initialisateur
        Dim Pupitre As Form

        Dim WithEvents MenuItem As ToolStripMenuItem
        Dim WithEvents Cacher_AppliFolder As New ToolStripMenuItem("Caché")

        Friend Sub New()
            Configuratrice.init()
        End Sub

        Private Sub Skin()

            Pupitre = New Form
            Pupitre.Text = "Configuration"
            'Pupitre.Width = 600
            Pupitre.Height = 200

            Dim Menu As New MenuStrip 'Menu de controle

            Dim Registre As New ToolStripMenuItem("Registre")
            Dim AppliFolder As New ToolStripMenuItem("Dossier")
            Dim AppliFile As New ToolStripMenuItem("Fichier")

            Menu.Items.Add(Registre)
            Menu.Items.Add(AppliFolder)
            Menu.Items.Add(AppliFile)

            Dim Enregistrer_AppliFile As New ToolStripMenuItem("Enregistrer")
            AppliFile.DropDownItems.Add(Enregistrer_AppliFile)

            Dim Changer_AppliFolder As New ToolStripMenuItem("Changer")
            AppliFolder.DropDownItems.Add(Changer_AppliFolder)
            Dim Effacer_AppliFolder As New ToolStripMenuItem("Effacer")
            AppliFolder.DropDownItems.Add(Effacer_AppliFolder)
            Cacher_AppliFolder.Checked = Configuratrice.CacheDataFolder
            AppliFolder.DropDownItems.Add(Cacher_AppliFolder)

            Dim Effacer_Registre As New ToolStripMenuItem("Effacer la sous-clé")
            Effacer_Registre.ToolTipText = "HKEY_CURRENT_USER \ SoftWare"
            Registre.DropDownItems.Add(Effacer_Registre)

            Dim BASIC_9 As New ToolStripMenuItem("BASIC_9\")
            Effacer_Registre.DropDownItems.Add("BASIC_9")

            Dim Key As RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("SoftWare\BASIC_9\")
            Try
                For Each Clef As String In Key.GetSubKeyNames
                    MenuItem = New ToolStripMenuItem
                    MenuItem.Text = Clef.ToString
                    Effacer_Registre.DropDownItems.Add(MenuItem)
                Next
            Catch ex As Exception
                QuestionDeRegistre()
            End Try

            Dim LabelChemin As New Label
            Dim BoutonValider As New Button
            BoutonValider.Text = "Enregistrer les paramètres"
            LabelChemin.Text = Configuratrice.Chemin
            BoutonValider.SetBounds(Pupitre.Width - 220, Pupitre.Height - 80, 180, 28)
            LabelChemin.SetBounds(0, 30, 1000, 28)
            Pupitre.Controls.Add(LabelChemin)
            Pupitre.Controls.Add(Menu)
            Pupitre.Controls.Add(BoutonValider)
        End Sub

        Private Sub Cacher_AppliFolder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Cacher_AppliFolder.Click
            Cacher_AppliFolder.Checked = Not Cacher_AppliFolder.Checked
        End Sub

        Private Sub SousMenuToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem.Click
            ' Try
            Dim Key As RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("SoftWare\BASIC_9\" & MenuItem.Text)
            Dim S As String = Key.GetValue(Configuratrice.Data_Label)
            'My.Computer.Registry.CurrentUser.SetAccessControl(Configuratrice.Ctrl)
            Elevation_Privilege_Prgm("C:\Windows\System32\cmd.exe", "/k dir C:\")
            Key.DeleteValue(Configuratrice.Data_Label)
            Key.DeleteSubKeyTree(MenuItem.Text) 'UnauthorizedAccessException
            ' Catch ex As Exception
            ' End Try
        End Sub

        Private Sub QuestionDeRegistre()
            Dim Q1 As System.Windows.Forms.DialogResult = MessageBox.Show( _
            Configuratrice.Chemin & " n'est pas enregistré dans Windows." & vbCr & "Faut-il ?" _
            , "Enregistrer dans Windows" _
            , MessageBoxButtons.YesNo, MessageBoxIcon.Question _
            , MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
            If Q1 = DialogResult.Yes Then
                Dim Q2 As System.Windows.Forms.DialogResult = MessageBox.Show( _
                "Confirmation de l'enregistrement " & Configuratrice.Chemin & vbCr & "sous clef" _
                & " HKEY_CURRENT_USER\SoftWare\BASIC_9\ " & Configuratrice.Cle & vbCr _
                & " avec l'étiquette: " & Configuratrice.Data_Label _
                , "Registre Windows" _
                , MessageBoxButtons.YesNo, MessageBoxIcon.Question _
                , MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)
                If Q2 = DialogResult.Yes Then
                    'Enregistre le chemin dans le registre.
                    Configuratrice.Data = Configuratrice.FullName
                End If

            End If
        End Sub

        Friend Sub Show()
            Skin()
            Pupitre.Show()
        End Sub

    End Class


    ''' <summary>
    ''' Inscrit le chemin du dossier de configuration
    ''' </summary>
    ''' <remarks></remarks>
    Friend Class Initialisateur

#Region "Interface"

        'Friend Ctrl As Security.AccessControl.RegistrySecurity
        Dim RootCle As String = "Software\BASIC_9\"
        Dim Nom() As String = {Nothing, Split(Process.GetCurrentProcess.ProcessName, ".")(0), My.Application.Info.AssemblyName}
        Friend Chemin As String = My.Application.Info.DirectoryPath 'Le chemin de l'application
        Dim index As Byte = 1 'SubCle = Nom sans extension du processus courant.
        Friend Data_Label As String = "AppliFolder"

        Friend DataFolderExist As Boolean = False
        Friend CacheDataFolder As Boolean = True


        Dim WithEvents F_Box As New FolderBox

#End Region

#Region "Implementation"

#Region "Fonctions principales"

        Friend Sub init(Optional ByVal Label As String = Nothing)
            If Label <> Nothing Then Data_Label = Label
            Dim PathStr1 As String = Data(1)
            Dim PathStr2 As String = Nothing
            'Dim ok As Boolean = False
            ' Teste la présence du dossier à partir des données du registre
            If My.Computer.FileSystem.DirectoryExists(IO.Path.GetDirectoryName(PathStr1)) Then
                DataFolderExist = True ': FullName = PathStr1
            Else
                PathStr2 = Data(2)
                If My.Computer.FileSystem.DirectoryExists(IO.Path.GetDirectoryName(PathStr2)) Then
                    DataFolderExist = True ': FullName = PathStr2
                End If
            End If
            If PathStr1 <> Nothing And PathStr1 <> "" Then
                FullName = PathStr1 : Quitter()
            Else
                If PathStr2 <> Nothing And PathStr2 <> "" Then : FullName = PathStr2 : Quitter()
                Else : Shown()
                End If
            End If

        End Sub

        Friend Sub New(Optional ByVal Clef As String = Nothing)
            'CacheDataFolder = True
            If Clef <> Nothing Then RootCle = Clef
        End Sub

        'Le dossier des données
        Friend Property FullName() As String
            Get
                Return Chemin & "\" & Nom(index) '& "\"
            End Get
            Set(ByVal value As String)
                Dim S As String() = Split(value, "\")
                index = 0 : Nom(index) = S(S.Length - 1)
                Chemin = value.Substring(0, value.Length - Nom(index).Length - 1)
                'Nom(index) = IO.Path.GetFileNameWithoutExtension(value)
                'Chemin = IO.Path.GetDirectoryName(value)
            End Set
        End Property

        ''' <summary>
        ''' Capsule de SubKey
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Property Cle(Optional ByVal i As Byte = 127) As String
            Get
                If i < 127 Then index = i
                Return Nom(index)
            End Get
            Set(ByVal value As String)
                index = 0
                Nom(index) = value
            End Set
        End Property

#End Region

#Region "Opérations sur le registre"

        ''' <summary>
        ''' Accès au registre (read/write))
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        '''
        Friend Property Data()
            Get
                Dim Key As RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey(RootCle & Cle)
                'Ctrl = My.Computer.Registry.CurrentUser.GetAccessControl()
                Try : Return Key.GetValue(Data_Label)
                Catch ex As Exception : Return Nothing
                End Try
            End Get
            Set(ByVal value)
                Dim Key As RegistryKey = My.Computer.Registry.CurrentUser.CreateSubKey(RootCle & Cle)
                Key.SetValue(Data_Label, value)
            End Set
        End Property
        Friend Property Data(ByVal Label As String)
            Get
                Data_Label = Label : index = 0
                Return Data()
            End Get
            Set(ByVal value)
                Data_Label = Label : index = 0
                Data = value
            End Set
        End Property
        Friend Property Data(ByVal IndexNum As Integer)
            Get
                index = IndexNum
                Return Data()
            End Get
            Set(ByVal value)
                index = IndexNum
                Data = value
            End Set
        End Property


        ''' <summary>
        ''' Efface l'inscription du registre
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub Clear()
            Try : Dim Key As RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey(RootCle)
                Key.DeleteSubKey(Cle) : Catch ex As Exception
            End Try
        End Sub

        ''' <summary>
        ''' Enregistre un script pour effacer l'inscription dans le registre
        ''' </summary>
        ''' <param name="Path"></param>
        ''' <remarks></remarks>
        Friend Sub Script(ByVal Path As String)
            Dim Regfile As New IO.StreamWriter(Path)
            Regfile.WriteLine("REGEDIT4")
            Regfile.WriteLine("[-HKEY_CURRENT_USER\" & RootCle & Cle & "]")
            Regfile.Close()
        End Sub

#End Region

#Region "Selection manuelle du répertoire"

        ''' <summary>
        ''' Crée le répertoire par défaut dans le répertoire de l'application si besoin
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub CreeDataFolder(Optional ByVal Path As String = Nothing)
            If Path <> Nothing Then Chemin = Path
            Dim Ok As Boolean = My.Computer.FileSystem.DirectoryExists(Chemin)
            If Not Ok Then
                Try : System.IO.Directory.CreateDirectory(Chemin) : Ok = True
                Catch ex As Exception : Ok = False : End Try : End If

            If Ok Then : System.IO.Directory.SetCurrentDirectory(Chemin)
                If CacheDataFolder = True Then 'DataFolder est caché
                    My.Computer.FileSystem.GetDirectoryInfo(Chemin).Attributes = _
                    IO.FileAttributes.Directory Or IO.FileAttributes.Hidden
                End If : End If
            DataFolderExist = Ok
        End Sub

        ''' <summary>
        ''' Ecrit le fichier de configuration, inscrit dans la base et enregistre un script
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub Cree_Config_File()
            Dim Ok As System.Windows.Forms.DialogResult = MessageBox.Show("Enregitrer la position du dossier '" _
                                  & Nom(index) & "' de l'application " _
                                  & Split(Process.GetCurrentProcess.ProcessName, ".")(0) _
             & vbLf & " dans la base de données de Windows.", "Registre Windows", _
       MessageBoxButtons.YesNo, MessageBoxIcon.Question, _
       MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)

            If Ok = DialogResult.Yes Then
                'Crée un fichier de configuration .reg, ouvre le fichier en mode Append
                Dim configFile As New IO.StreamWriter(FullName & ".cfg", True)

                configFile.WriteLine("<Assembly>" & My.Application.Info.AssemblyName & "</Assembly>")
                configFile.WriteLine("<UserName>" & Split(Process.GetCurrentProcess.ProcessName, ".")(0) & "</UserName>")
                configFile.WriteLine("<config>")
                configFile.WriteLine("<Path>" & Chemin & "</Path>")
                configFile.WriteLine("<Nom>" & Nom(0) & "</Nom>")
                configFile.WriteLine("<Index>" & index & "</Index>")
                configFile.WriteLine("<Attribut/Cache>" & CacheDataFolder.ToString & "</Attribut/Cache>")
                configFile.WriteLine("<Registre>")
                configFile.WriteLine("<Cle>" & RootCle & "</Cle>")
                configFile.WriteLine("<AppliFolder>" & FullName & "</AppliFolder>")
                configFile.WriteLine("</Registre>")
                configFile.WriteLine("</config>")
                configFile.Close()

                'Inscrit le dossier dans le registre.
                Data = FullName
                Script(FullName & "_Delete.reg")

                Quitter()
            End If
        End Sub

        ''' <summary>
        ''' Etat de l'attribut du dossier de configuration dans son fichier
        ''' </summary>
        ''' <param name="File_Name"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Function Attribut_Cache(ByVal File_Name As String) As Boolean
            Dim configFile As New IO.StreamReader(File_Name)
            Dim S As String = configFile.ReadToEnd : configFile.Close()
            Dim v As String = "Attribut/Cache"
            Dim A As String = "<" & v & ">"
            'Dim i As Integer = InStr(S, A) + A.Length - 1
            S = S.Substring(InStr(S, A) + A.Length - 1)
            Dim Z As String = "</" & v & ">"
            Return S.Substring(0, InStr(S, Z) - 1)
        End Function

        ''' <summary>
        ''' Selection manuelle du répertoire
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub Shown()
            If Not DataFolderExist Then 'Si pas de dossier par défaut
                F_Box.PathTree(Chemin)
                F_Box.Add(Nom(index))
            Else 'Si le registre contiend une donnée
                If Not DataFolderExist Then 'Il y a une cle mais le chemin ne correspond à rien.
                    F_Box.PathTree(Chemin)
                    Chemin = F_Box.SelectedNode.FullPath
                    F_Box.Add(Nom(index))
                Else
                    CacheDataFolder = Attribut_Cache(FullName & ".cfg")
                End If
            End If
        End Sub


#Region "Evênements liants les boutons aux procédures d'initialisation"

        ''' <summary>
        ''' Ajoute le dossier de configuration dans l'arbre
        ''' </summary>
        ''' <remarks></remarks>
        Private Sub AjouteDossier_Clic() Handles F_Box.AjouteDossier
            F_Box.Add(Nom(index))
        End Sub

        ''' <summary>
        ''' Enregistre le nouveau dossier (EdiNode) de l'arbre
        ''' </summary>
        ''' <remarks></remarks>
        Private Sub Cree_Dossier_Clic() Handles F_Box.Cree_Dossier
            CreeDataFolder(F_Box.Active_Node.FullPath)
            Nom(0) = F_Box.Active_Node.Text : index = 0
            Cree_Config_File()
        End Sub

#End Region
#End Region

        Private Sub Quitter()
            'NewPupitre()
        End Sub

#End Region

    End Class

    '.........TreeView.......
#Region "Arbre de dossiers"


    ''' <summary>
    ''' Dialogue de sauvegarde
    ''' </summary>
    ''' <remarks></remarks>
    Public Class Dialog 'Ouvrir ou fermer un fichier
        Dim Lecture As Boolean = True
        Public Directory As String
        Public racine As String = "essai"
        Public Extension As String = ".txt"
        Public Filtre As String = "Tous les fichiers|*.*"

        Public Sub New(Optional ByVal Default_File_Name As String = "")
            If Default_File_Name = "" Then
                Directory = My.Computer.FileSystem.SpecialDirectories.Desktop
            Else : Name = Default_File_Name : End If
        End Sub
        'Ajouter une extension et un commentaire éventuel dans le filtre de selection des fichiers
        Public Sub AddFiltre _
        (ByRef Extension As String, Optional ByRef Description As String = "*")
            If Description = "*" Then Description = "*" & Extension
            Filtre = Description & "|*" & Extension & "|" & Filtre
        End Sub
        'Nom complet (Chemin\nom de fichier.extension)
        Public Property Name() As String
            Get
                Return Directory + "\" + racine + Extension
            End Get
            Set(ByVal File_Name As String)
                Directory = System.IO.Path.GetDirectoryName(File_Name)
                racine = System.IO.Path.GetFileNameWithoutExtension(File_Name)
                Extension = System.IO.Path.GetExtension(File_Name)
            End Set
        End Property

        ''' <summary>
        ''' Selection du fichier dans l'explorateur
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks> Using D As New Dialog: D.Charge: Dim Fichier As String = D.Name : End Using </remarks>
        Public Function Charge() As DialogResult
            Dim Ok As DialogResult
            Using Ofd As New OpenFileDialog
                Ofd.Filter = Filtre
                Ofd.InitialDirectory = Directory
                Ok = Ofd.ShowDialog()
                If Ok = DialogResult.OK Then
                    Name = Ofd.FileName : End If
            End Using
            Return Ok
        End Function
        'Using D As New Dialog: D.Sauve: Dim Fichier As String = D.Name : End Using
        Public Function Sauve() As DialogResult
            Dim Ok As DialogResult
            Using Sfd As New SaveFileDialog
                Sfd.Filter = Filtre
                Sfd.InitialDirectory = Directory
                Ok = Sfd.ShowDialog()
                If Ok = DialogResult.OK Then
                    Name = Sfd.FileName : End If
            End Using
            Return Ok
        End Function

    End Class

    ''' <summary>
    ''' Exploration de Fichiers
    ''' </summary>
    ''' <remarks></remarks>
    Friend Class File_Explo

#Region "Interface de Données"

        Dim SelectedFile As String = ""
        ' Friend SelectedPath As String = ""
        Friend WithEvents Tree As New FolderTree
        Friend WithEvents List As New ListBox
        Friend Texto As New TextBox

        Friend Event AfterSelect(ByVal e As TreeViewEventArgs)
        Friend Event BeforeExpand(ByVal e As TreeViewCancelEventArgs)

#End Region

        Friend Function SelectedPath() As String
            SelectedPath = Tree.SelectedNode.FullPath
        End Function

#Region "Evênements"

        Private Sub PrintFileList(ByVal oParent As TreeNode)
            Dim oFS As New IO.DirectoryInfo(oParent.FullPath & "\")
            Dim oFile As IO.FileInfo
            List.Items.Clear()
            Try
                For Each oFile In oFS.GetFiles()
                    List.Items.Add(oFile.Name)
                Next
            Catch ex As Exception
                MsgBox("Impossible de lister les fichiers de la " & oParent.FullPath & "\")
            End Try
        End Sub

        Private Sub Tree_BeforeExpand(ByVal e As TreeViewCancelEventArgs) Handles Tree.BeforeExpand
            RaiseEvent BeforeExpand(e)
        End Sub

        Private Sub Tree_AfterSelect(ByVal e As TreeViewEventArgs) Handles Tree.AfterSelect
            ' Private Sub Tree_AfterSelect(ByVal TN As TreeNode) Handles Tree.AfterSelect
            'SelectedPath = Tree.Chemin + e.Node.Text
            PrintFileList(e.Node)
            'SelectedPath = Tree.Chemin + TN.Text : PrintFileList(TN)
            Texto.Text = IO.Path.GetFileNameWithoutExtension(Tree.SelectedNode.FullPath)
            RaiseEvent AfterSelect(e)
        End Sub

        Private Sub Tree_Click() Handles Tree.Click
            Texto.Text = IO.Path.GetFileNameWithoutExtension(Tree.SelectedNode.FullPath)
            ' RaiseEvent Click()
        End Sub

        Private Sub ListBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) Handles List.SelectedIndexChanged
            SelectedFile = List.Items.Item(List.SelectedIndex)
            Texto.Text = IO.Path.GetFileNameWithoutExtension(SelectedFile)
            ' RaiseEvent SelectedIndexChanged()
        End Sub

#End Region

    End Class

    ''' <summary>
    ''' Selection manuelle d'un dossier
    ''' </summary>
    ''' <remarks>Arbre des dossiers avec 2 boutons</remarks>
    Friend Class FolderBox
        Inherits FolderTree

#Region "Interface de Données"

        Dim WithEvents Cadre As New Form
        Friend WithEvents Bouton_Ajouter As New Button
        Friend WithEvents Bouton_OK As New Button
        Dim Panneau As New Panel

        Friend Event Cree_Dossier()
        Friend Event AjouteDossier()

        Friend EdiNode As New TreeNode 'Le Dossier qu'on ajoute
        Friend Edit_Mode As Boolean ' = True

#End Region

#Region "Commandes"

        ''' <summary>
        ''' Paramètres de la fenêtre et des boutons
        ''' </summary>
        ''' <remarks></remarks>
        Friend Sub New()
            Cadre.TopMost = True
            Cadre.Controls.Add(Tree)
            Tree.Dock = DockStyle.Fill
            Tree.LabelEdit = False
            Tree.HideSelection = False
            Cadre.Controls.Add(Panneau)
            Panneau.SetBounds(0, 0, 60, 28)
            Panneau.Dock = DockStyle.Bottom
            Bouton_Ajouter.Text = "Ajouter un dossier"
            Bouton_Ajouter.SetBounds(3, 3, 100, 23)
            Bouton_Ajouter.Enabled = False
            Bouton_OK.Text = "Confirmer"
            Bouton_OK.SetBounds(106, 3, 60, 23)
            Bouton_OK.Enabled = False
            Panneau.Controls.Add(Bouton_Ajouter)
            Panneau.Controls.Add(Bouton_OK)
            iniTree(Tree)
        End Sub

        Friend Sub ShowDialog()
            Cadre.Show()
        End Sub

        ''' <summary>
        ''' Ennoncé du cadre de la fenêtre
        ''' </summary>
        ''' <value></value>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Friend Property titre() As String
            Get
                Return Cadre.Text
            End Get
            Set(ByVal Libelle As String)
                Cadre.Text = Libelle
            End Set
        End Property

        ''' <summary>
        ''' Edite un nouveau dossier
        ''' </summary>
        ''' <param name="FolderName"></param>
        ''' <remarks></remarks>
        Friend Sub Add(Optional ByVal FolderName As String = "Nouveau Dossier")
            EdiNode.ImageIndex = 0
            EdiNode.SelectedImageIndex = 0
            EdiNode.Text = FolderName
            SelectedNode.Nodes.Insert(0, EdiNode)

            Bouton_Ajouter.Enabled = False
            Bouton_OK.Enabled = True

            SelectedNode.Expand()
            Tree.LabelEdit = True
            EdiNode.BeginEdit()
        End Sub

        'Pour imbriquer les créations de dossier (activer le bouton ajouter pendant l'édition)
        Friend Function Active_Node() As TreeNode
            If Edit_Mode Then : Return EdiNode : Else : Return SelectedNode : End If
        End Function

        Friend Sub PathTree(ByVal Path As String)
            titre = "Créer le dossier d'application"
            ShowDialog()
            SelectedNode = Expand(Path)
            SelectedNode.ForeColor = Color.Green
        End Sub

#End Region

#Region "Evênements"

#Region "Evênements de boutons"

        ''' <summary>
        ''' Bouton_Ok Click Cree_Dossier
        ''' </summary>
        ''' <param name="sender"></param>
        ''' <param name="e"></param>
        ''' <remarks></remarks>
        Private Sub Bouton_OK_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Bouton_OK.Click
            Me.Cadre.Close()
            RaiseEvent Cree_Dossier()
        End Sub

        ''' <summary>
        ''' Ajoute un noeud
        ''' </summary>
        ''' <param name="sender"></param>
        ''' <param name="e"></param>
        ''' <remarks></remarks>
        Private Sub Bouton_Ajouter_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Bouton_Ajouter.Click
            Bouton_OK.Enabled = True
            RaiseEvent AjouteDossier()
        End Sub
#End Region

#Region "Evênements Clicks"

        Private Sub Tree_AfterSelect(ByVal sender As Object, ByVal e As Windows.Forms.TreeViewEventArgs) Handles Tree.AfterSelect
            If Edit_Mode Then
                If EdiNode.FullPath = SelectedNode.FullPath Then
                    'EdiNode.EndEdit(False)
                    'EdiNode = SelectedNode
                    'Tree.LabelEdit = True
                    'EdiNode.BeginEdit()
                Else
                    EdiNode.Remove()
                    Tree.LabelEdit = False
                    Edit_Mode = False
                    'Bouton_OK.Enabled = False
                    Bouton_Ajouter.Enabled = True
                End If
            End If
        End Sub

        ' Private Sub Tree_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Tree.Click

        'End Sub

        Private Sub Tree_AfterLabelEdit(ByVal sender As Object, ByVal e As NodeLabelEditEventArgs) Handles Tree.AfterLabelEdit
            Edit_Mode = True
        End Sub

#End Region

#End Region

    End Class

    ''' <summary>
    ''' Noeud de dossier "SelectedNode"
    ''' </summary>
    ''' <remarks>Mécanisme interne</remarks>
    Friend Class FolderTree

#Region "Interface de Données"
        Friend WithEvents Tree As New TreeView
        Friend SelectedNode As TreeNode
        'Friend SelectedPath As String
        Dim Directory_Only As Boolean = True

        Friend Event BeforeExpand(ByVal e As TreeViewCancelEventArgs)
        Friend Event AfterSelect(ByVal e As TreeViewEventArgs)
        Friend Event Click()

#End Region

#Region "Commandes"

        Friend Function Expand(ByVal S As String) As TreeNode
            Dim T As String() = Split(S, "\")
            Dim D As Byte = Nothing 'Indice du périphérique
            For N As Integer = 1 To Tree.Nodes.Count
                If Tree.Nodes.Item(N - 1).Text = T(0) Then D = N - 1
            Next
            Dim V As TreeNode = Tree.Nodes.Item(D) : V.Expand()

            Dim ok As Boolean = True
            Dim i As Integer = -1
            For j As Integer = 1 To T.Length - 1
                If Not ok Then Exit For
                i = -1
                For N As Integer = 1 To V.Nodes.Count
                    If V.Nodes.Item(N - 1).Text = T(j) Then i = N - 1
                Next
                If i > -1 Then : V = V.Nodes.Item(i) : V.Expand() : Else : ok = False : End If
            Next
            Return V
        End Function

#End Region

#Region "Evênements"

        Private Sub Tree_BeforeExpand(ByVal sender As Object, ByVal e As TreeViewCancelEventArgs) Handles Tree.BeforeExpand
            'If not AutoExpand Then
            Sub_BeforeExpand(e.Node)
            'End If
            RaiseEvent BeforeExpand(e)
        End Sub

        Private Sub Tree_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles Tree.AfterSelect
            'SelectedPath = Chemin + e.Node.Text
            SelectedNode = e.Node
            RaiseEvent AfterSelect(e)
        End Sub

#End Region

#Region "Implementation"
        Friend Chemin As String

        ''' <summary>
        ''' Sous=Programme principal de l'évênement Tree_BeforeExpand
        ''' </summary>
        ''' <param name="oNode"></param>
        ''' <remarks></remarks>
        Friend Sub Sub_BeforeExpand(ByVal oNode As TreeNode)
            If oNode.ImageIndex = 2 Then Exit Sub
            Try : If oNode.GetNodeCount(False) = 1 And oNode.Nodes(0).Text = "" Then
                    oNode.Nodes(0).Remove()
                    AttacheDir(oNode)
                End If : Catch ex As Exception
                MsgBox("Impossible de développer " & oNode.FullPath & ":" & ex.ToString) : End Try
            If oNode.GetNodeCount(False) > 0 Then
                oNode.ImageIndex = 1 : oNode.SelectedImageIndex = 1
            End If
        End Sub

        Private Sub Affichefils(ByVal oParent As TreeNode)
            AttacheDir(oParent) : If Not Directory_Only Then AttacheFile(oParent)
        End Sub

        Friend Sub iniTree(ByRef View As TreeView)
            Try
                For Each drive As IO.DriveInfo In My.Computer.FileSystem.Drives
                    If drive.IsReady Then
                        Dim oNode As New TreeNode()
                        oNode.ImageIndex = 0
                        oNode.SelectedImageIndex = 0
                        oNode.Text = drive.Name.Substring(0, 2)
                        oNode.Nodes.Add("")
                        View.Nodes.Add(oNode)
                    End If
                Next
            Catch ex As Exception
                MsgBox("Impossible de créer le noeud initial:" & ex.ToString)
            End Try
        End Sub

        Friend Sub AttacheDir(ByVal oParent As TreeNode)
            Dim oFS As New IO.DirectoryInfo(oParent.FullPath & "\")
            Dim oDir As IO.DirectoryInfo
            Try
                For Each oDir In oFS.GetDirectories()
                    Dim oNode As New TreeNode()
                    oNode.ImageIndex = 0
                    oNode.SelectedImageIndex = 0
                    oNode.Nodes.Add("")
                    oNode.Text = oDir.Name
                    oParent.Nodes.Add(oNode)
                Next
                Chemin = oParent.FullPath + "\"
                TriDir(oParent)
            Catch ex As Exception
                MsgBox("Impossible de lister l'arborescence de " & oParent.FullPath & ":" & ex.ToString)
            End Try
        End Sub

        Friend Sub AttacheFile(ByVal oParent As TreeNode)
            Dim oFS As New IO.DirectoryInfo(oParent.FullPath & "\")
            Dim oFile As IO.FileInfo
            Try
                For Each oFile In oFS.GetFiles()
                    Dim oNode As New TreeNode()
                    oNode.Text = oFile.Name
                    oNode.ImageIndex = 2
                    oNode.SelectedImageIndex = 2
                    oParent.Nodes.Add(oNode)
                Next
            Catch ex As Exception
                MsgBox("Impossible de lister les fichiers dans " & oParent.FullPath & ":" & ex.ToString)
            End Try
        End Sub

        Private Sub TriDir(ByVal oParent As TreeNode)
            Dim i, j As Integer
            Dim S As String
            Dim A, B As New TreeNode

            For i = oParent.Nodes.Count - 1 To 1 Step -1
                For j = 0 To i - 1
                    A = oParent.Nodes.Item(j + 1)
                    B = oParent.Nodes.Item(j)
                    If String.Compare(A.Text, B.Text) = -1 Then
                        S = A.Text : A.Text = B.Text : B.Text = S
                    End If
                Next j
            Next i
        End Sub

#End Region

    End Class


#End Region 'Voir SkinDos

End Module