VB - Fyll en TreeView med systemdiskarna och deras kataloger

Här är en rutin som kan fylla en TreeView med systemdiskarna och deras kataloger.

Beskrivning

Problemet var att hitta noden nyckeln, som ibland en nyckel publicerades två gånger, då hittade jag en lösning:

Använd den fullständiga sökvägen som nyckeln och det är därför säkert att det inte kommer några duplikat.
Jag kunde inte testa nätverksenheterna
Jag eliminerade systemkatalogerna, mitt mål är att göra en bild utforska (tillgänglig för nedladdning).
Rutinen är rekursiv och är relativt kort.
Bli inte förvånad över hur lång tid det tar (beroende på ditt system), men rutinen är nästan lika snabb som Windows Explorer, förutom att den inte automatiskt startas som start.
Du kan ladda ner projektet en komplett bild explodera i VB6.
När du klickar på en bild visas meddelandet Antal och hela sökvägen till bilden.
Du kan också ändra filtren för att tillåta visning av andra bilder.

Projektet innehåller en anpassad OCX och DLL, du måste:

Unzip mappen.
Klicka inte på projektet, navigera till VB6-ikonen, högerklicka på ikonen och öppna som administratör.
Vid öppningen klickar du på "Befintlig" och öppnar projektet LN_Explorateur.vpb
Ändra bredden på TreeView genom att flytta den röda linjen (klicka på linjen och flytta).
- Ändra storleken på miniatyrer med "S" -tangenten.

Bildskärmen utförs med Gdi + dll reducerad till dess enklaste uttryck.

Jag tror att rutinen enkelt kan omsättas till VB.Net

Koda

Alternativ Explicit

 Sub Initialise_TreeDir (TreeDir As TreeView) Dim ExpDr, Rep, Drv, S Som sträng, N, D, a, r, Unite Dim Cle som sträng, sCle som sträng, Num som heltal, Sr som heltal Dim nodX som nod Num = 64 Ställ ExpDr = CreateObject ("Scripting.FileSystemObject") Ange Drv = ExpDr.Drives för varje D i Drv S = D.DriveLetter '& ":" Om D.DriveType = 3 Then' réseaux N = D.ShareName ElseIf D.DriveType = 1 Då "DD extern N =" - Média amovible - ("& D.VolumeName &") "Incr Num: Cle = SS = S &": \ "Ange nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Då "DD N = D.VolumeName Incr Num: Cle = SS = S &": \ "Ange nodX = TreeDir.Nodes.Add, S & "- (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Då 'DVD On Error Fortsätt Nästa N = D.VolumeName Om Err = 71 Då N = "Lecteur DVD - (vide) "Annars N =" Lecteur DVD - ("& N &") "Sluta om Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Ange nodX = TreeDir.Nodes .Add (,, Cle, S & N, 3) Else Stop End Om S = "" D = "Nästa Ställ NoX = Inget Ställ ExpDr = Inget Ställ Drv = Inget Slut Sub Sub AjoutRep (Chem As String, Släng som String, TreeDir Som TreeView) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle Som String, Num As Integer, Sr Som heltal Dim nodX Som nod Dim NbsR Som heltal, S som sträng Sr = 9 Chem = Chem & IIf (Höger (Chem, 1) = "\", "", "\") Ställ Obj = CreateObject ("Scripting .FileSystemObject ") Ange Rep = Obj.Getfolder (Chem) Om vänster (Rep.Name, 1) =" $ "Då Gå till Passe2 Ange sRep = Rep.subfolders För varje sRp I sRep S = UCase (sRp.Name) Om vänster (S, 1) = "$" eller S = "WINDOWS" eller sRp.Attributes> 100 eller sRp.Attributes = 19 _ eller vänster (S, 6) = "SYSTEM" eller vänster (S, 7) = "PROGRAM" Eller vänster (S, 4) = "ANVÄNDAR" _ eller vänster (S, 6) = "DRIVER" eller vänster (S, 5) = "VERKTYG" Gå sedan vidare till fel Fortsätt Nästa uppsättning sR2 = sRp.subfolders NbsR = sR2 .Count Om Err 0 Då Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" På Fel GoTo 0 'Debug.Print sRp.Name; ""; cle; ""; sCle Ange nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Om NbsR> 0 Då AjoutRep sRp.Path, sCle, TreeDir avsluta om Passe: Next Passe2: Set Obj = Inget Set Rep = Inget Ange sRep = Inget Ange nodX = Inget Ange sR2 = Inget Slut Del