VB - Udfyld et TreeView med systemdiske og deres mapper

Her er en rutine, der kan udfylde en TreeView med systemdiske og deres mapper.

Beskrivelse

Problemet var at finde nodenøglen, da nogle gange blev en nøgle udgivet to gange, så fandt jeg en løsning:

Brug den fulde sti som nøgle, og på denne måde er det sikkert, at der ikke bliver duplikater.
Jeg kunne ikke teste netværksdrevene
Jeg fjernede systemkatalogerne, mit mål er at lave et billede udforskning (tilgængelig til download).
Rutinen er rekursiv og er relativt kort.
Lad dig ikke blive overrasket over, hvor lang tid det tager (afhængigt af dit system), men rutinen er næsten lige så hurtig som Windows Explorer, bortset fra at den ikke automatisk startes som opstart.
Du kan downloade projektet et komplet billede eksplodere i VB6.
Når du klikker på et billede, viser meddelelsen nummeret og den fulde sti til billedet.
Du kan også ændre filtre for at tillade visning af andre billeder.

Projektet indeholder en brugerdefineret OCX og DLL, du skal:

Udpak mappen.
Klik ikke på projektet, naviger til VB6-ikonet, højreklik på ikonet og åbner som administrator.
Ved åbningen skal du klikke på 'Eksisterende' og åbne projektet LN_Explorateur.vpb
Ændre bredden af TreeView ved at flytte den røde linje (klik på linjen og flyt).
- Ændre størrelsen på miniaturerne med 'S' tasten.

Billedvisningen udføres med Gdi + dll reduceret til sit simpleste udtryk.

Jeg tror, at rutinen nemt kan omsættes til VB.Net

Kode

Mulighed Eksplicit

 Sub Initialise_TreeDir (TreeDir As TreeView) Dim ExpDr, Rep, Drv, S Som streng, N, D, a, r, Unite Dim Cle som streng, sCle As String, Num Som Integer, Sr Som Integer Dim nodX Som Node Num = 64 Indstil ExpDr = CreateObject ("Scripting.FileSystemObject") Indstil Drv = ExpDr.Drives for hver D i Drv S = D.DriveLetter '& ":" Hvis D.DriveType = 3 Then' réseaux N = D.ShareName ElseIf D.DriveType = 1 Derefter 'DD ekstern N = "- Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ": \" Indstil nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Derefter 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Indstil nodX = TreeDir.Nodes.Add, S & "- (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Derefter 'DVD On Error Genoptag Næste N = D.VolumeName Err = 71 Så N = "Lecteur DVD - (vide) "Else N =" Lecteur DVD - ("& N &") "Afslut Hvis Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Indstil nodX = TreeDir.Nodes .Add (,, Cle, S & N, 3) Else Stop End Hvis S = "" D = "" Næste sæt nodX = Intet sæt ExpDr = Intet sæt Drv = Intet End Sub Sub AjoutRep (Chem som streng, klip som streng, TreeDir som TreeView) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle som streng, Num som helhed, Sr Som helhed Dim nodX Som Node Dim NbsR Som helhed, S Som streng Sr = 9 Chem = Chem & IIf (Højre (Chem, 1) = "\", "", "\") Indstil Obj = CreateObject ("Scripting .FileSystemObject ") Sæt Rep = Obj.Getfolder (Chem) Hvis Venstre (Rep.Name, 1) =" $ "Så Gå Til Passe2 Indstil sRep = Rep.subfolders For hver sRp I sRep S = UCase (sRp.Name) (S, 1) = "$" eller S = "WINDOWS" eller sRp.Attributes> 100 eller sRp.Attributes = 19 eller Venstre (S, 6) = "SYSTEM" eller Venstre (S, 7) = "PROGRAM" Eller venstre (S, 4) = "USER" _ eller venstre (S, 6) = "DRIVER" eller venstre (S, 5) = "TOOLS" .Count Hvis Err 0 Så Err = 0: Go To Pass Incr Sr sCle = sRp.Path & "\" På Fejl GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCle Indstil nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Hvis NbsR> 0 Så AjoutRep sRp.Path, sCle, TreeDir End Hvis Passe: Next Passe2: Set Obj = Intet Set Rep = Intet sæt sRep = Intet sæt nodX = Intet sæt sR2 = Intet End Sub