VB - Vul een TreeView in met de systeemschijven en hun mappen

Hier is een routine die een TreeView kan vullen met de systeemschijven en hun mappen.

Omschrijving

Het probleem was om de knooppuntentoets te vinden, omdat er soms twee keer een sleutel werd gepubliceerd, en toen vond ik een oplossing:

Gebruik het volledige pad als sleutel en op deze manier is het zeker dat er geen duplicaten zijn.
Ik kon de netwerkschijven niet testen
Ik heb de systeemmappen uitgeschakeld, mijn doel is om een afbeelding te laten verkennen (beschikbaar om te downloaden).
De routine is recursief en relatief kort.
Wees niet verbaasd hoe lang het duurt (afhankelijk van je systeem), maar de routine is bijna net zo snel als Windows Explorer, behalve dat het niet automatisch wordt gestart als opstarten.
Je kunt het project een complete image exploere in VB6 downloaden.
Wanneer u op een afbeelding klikt, geeft het bericht het nummer en het volledige pad naar de afbeelding weer.
U kunt de filters ook wijzigen om andere afbeeldingen weer te geven.

Het project bevat een aangepaste OCX en DLL, u moet:

Pak de map uit.
Klik niet op het project, navigeer naar het VB6-pictogram, klik met de rechtermuisknop op het pictogram en open als beheerder.
Klik bij de opening op 'Bestaand' en open het LN_Explorateur.vpb-project
Wijzig de breedte van de TreeView door de rode lijn te verplaatsen (klik op de lijn en verplaats).
- Wijzig de grootte van miniaturen met de 'S'-toets.

De beeldweergave wordt uitgevoerd met de Gdi + dll teruggebracht tot de eenvoudigste uitdrukking.

Ik denk dat de routine eenvoudig kan worden omgezet naar VB.Net

Code

Optie Expliciet

 Sub Initialise_TreeDir (TreeDir As TreeView) Dim ExpDr, Rep, Drv, S As String, N, D, a, r, Unite Dimension Cle als string, sCle As String, Num As Integer, Sr As Integer Dim nodX As Node Num = 64 Stel ExpDr = CreateObject in ("Scripting.FileSystemObject") Stel Drv = ExpDr.Drives in voor elke D in Drv S = D.DriveLetter '& ":" If D.DriveType = 3 Then' réseaux N = D.ShareName ElseIf D.DriveType = 1 Dan 'DD externe N = "- Média amovible - (" & D.VolumeName & ")" Increment Num: Cle = SS = S & ": \" Stel nodX = TreeDir.Nodes.Add (,, Cle, S in & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Then 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Stel nodX = TreeDir.Nodes.Add (,, Cle in, 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 = "Lecteur DVD - (vide) "Else N =" Lecteur DVD - ("& N &") "End If Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Stel nodX in = TreeDir.Nodes . Toevoegen (,, Kl, S & N, 3) Anders Stop einde Als S = "" D = "" Volgende Set nodX = Niets Set ExpDr = Niets Set Drv = Niets 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) = "$" Of S = "WINDOWS" Of sRp.Attributes> 100 Of sRp.Attributes = 19 _ Of Left (S, 6) = "SYSTEM" of Left (S, 7) = "PROGRAMMA" Of Left (S, 4) = "USER" _ Of Left (S, 6) = "DRIVER" Of Left (S, 5) = "TOOLS" Then GoTo Passe On Error Resume Volgende 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