VB - Preencher uma TreeView com os discos do PC

Dezembro 2016

Uma rotina para preencher uma TreeView com os Discos do sistema e seus diretórios.
O difícil foi encontrar as chaves dos nós, uma chave era sempre publicada duas vezes, depois eu encontrei o truque, coloquei o caminho completo do diretório como chave e, deste modo, evitei as duplicatas.
Eu não testei os discos de redes já que não tenho redes; só você pode saber se pode fazê-lo.
Eu eliminei os diretórios do sistema, já que o meu objetivo era criar um explorador de imagens. (Disponível para o download).
A rotina é recursiva e relativamente curta.

Não se espante com a demora (dependendo do seu sistema), mas a rotina é quase tão rápida quanto o Windows Explorer, exceto que ela não funciona para inicializar o PC. Para fazer uma comparação, veja quanto tempo leva o Windows para inicializar um disco rígido externo ou uma chave.

Você pode baixar o projeto completo de um explorador de imagens em VB6.

Ao clicar em uma imagem a mensagem exibe o número e o caminho completo da imagem, você pode fazer o que quiser.
Você também pode alterar os filtros para exibir outras imagens.
O projeto contém uma OCX e uma DLL personalizada, então, você deve ...
Descompactar o diretório.
Não clique no projeto, navegue até o ícone do VB6, clique com o botão direito do mouse no ícone e abra como administrador.
Na abertura clique em "Existente" e abra o projeto LN_Explorador.vpb
Nota: Isso só é necessário na primeira vez, depois funciona normalmente.
Modificar a largura da TreeView movendo a linha vermelha. (Clique na linha e mova-a)
Alterar o tamanho das miniaturas com o botão `S''
A exibição das imagens é realizada com a dll GDI+ reduzida à sua mais simples expressão.

Eu acho que a rotina pode ser facilmente transposta para VB.Net

O Código da rotina


Option Explicit 

Sub Initialise_TreeDir(TreeDir As TreeView) 
Dim ExpDr, Rep, Drv, S As String, N, D, a, r, Unite 
Dim Cle As String, sCle As String, Num As Integer, Sr As Integer 
Dim nodX As Node 
    Num = 64 
    Set ExpDr = CreateObject("Scripting.FileSystemObject") 
    Set Drv = ExpDr.Drives 
    For Each D In Drv 
        S = D.DriveLetter '& ":" 
        If D.DriveType = 3 Then 'redes 
            N = D.ShareName 
        ElseIf D.DriveType = 1 Then  'DD externo 
            N = " - Mídia removível - (" & D.VolumeName & ")" 
            Incr Num: Cle = S 
            S = S & ":\" 
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 6) 
            AjoutRep S, Cle, TreeDir 
        ElseIf D.DriveType = 2 Then  'DD 
            N = D.VolumeName 
            Incr Num: Cle = S 
            S = S & ":\" 
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & " - (" & N & ")", 2) 
            AjoutRep S, Cle, TreeDir 
        ElseIf D.DriveType = 4 Then 'DVD 
            On Error Resume Next 
            N = D.VolumeName 
            If Err = 71 Then 
                N = "Leitor DVD - (vide) " 
            Else 
                N = "Leitor DVD - (" & N & ")" 
            End If 
            Incr Num: Cle = Chr(Num) & "0" 
            S = S & ":\ - " 
            Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 3) 
        Else 
            Stop 
        End If 
        S = "" 
        D = "" 
    Next 
    Set nodX = Nothing 
    Set ExpDr = Nothing 
    Set Drv = Nothing 

End Sub 

Sub AjoutRep(Chem As String, Cle As String, TreeDir As TreeView) 
Dim Rep, sRp, Obj, sRep, sR2 
Dim sCle As String, Num As Integer, Sr As Integer 
Dim nodX As Node 
Dim NbsR As Integer, S As String 
Sr = 9 
    Chem = Chem & IIf(Right(Chem, 1) = "\", "", "\") 
    Set Obj = CreateObject("Scripting.FileSystemObject") 
    Set Rep = Obj.Getfolder(Chem) 
    If Left(Rep.Name, 1) = "$" Then GoTo Passe2 
    Set sRep = Rep.subfolders 
    For Each sRp In sRep 
        S = UCase(sRp.Name) 
        If Left(S, 1) = "$" Or S = "WINDOWS" Or sRp.Attributes > 100 Or sRp.Attributes = 19 _ 
            Or Left(S, 6) = "SYSTEM" Or Left(S, 7) = "PROGRAM" Or Left(S, 4) = "USER" _ 
            Or Left(S, 6) = "DRIVER" Or Left(S, 5) = "TOOLS" Then GoTo Passe 
        On Error Resume Next 
        Set sR2 = sRp.subfolders 
        NbsR = sR2.Count 
        If Err <> 0 Then Err = 0: GoTo Passe 
        Incr Sr 
        sCle = sRp.Path & "\" 
        On Error GoTo 0 
        'Debug.Print sRp.Name; "   "; Cle; "  "; sCle 
        Set nodX = TreeDir.Nodes.Add(Cle, tvwChild, sCle, sRp.Name, 5, 4) 
        If NbsR > 0 Then 
            AjoutRep sRp.Path, sCle, TreeDir 
        End If 
Passe: 
    Next 
Passe2: 

    Set Obj = Nothing 
    Set Rep = Nothing 
    Set sRep = Nothing 
    Set nodX = Nothing 
    Set sR2 = Nothing 
End Sub 

Download


Site 1 : LN_Explorador
Site 2 : LN_Explorador

NOTA


Esta dica é a primeira parte de um aplicativo completo para o processamento de imagens que será publicado posteriormente.


Tradução feita por Lucia Maurity y Nouira

Veja também :
Este documento, intitulado « VB - Preencher uma TreeView com os discos do PC »a partir de CCM (br.ccm.net) está disponibilizado sob a licença Creative Commons. Você pode copiar, modificar cópias desta página, nas condições estipuladas pela licença, como esta nota aparece claramente.