VB - Napolnite TreeView s sistemskimi diski in njihovimi imeniki

Tukaj je podprogram, ki lahko zapolni TreeView s sistemskimi diski in njihovimi imeniki.

Opis

Težava je bila v iskanju ključev vozlišč, saj je včasih ključ dvakrat objavljen, potem pa sem našel rešitev:

Uporabite celotno pot kot ključ in na ta način je gotovo, da ne bo nobenih dvojnikov.
Nisem mogel preizkusiti omrežnih pogonov
Izločil sem sistemske imenike, moj cilj je narediti sliko raziskati (na voljo za prenos).
Rutina je rekurzivna in relativno kratka.
Ne bodite presenečeni, koliko časa traja (odvisno od vašega sistema), vendar je rutina skoraj tako hitra kot Windows Explorer, razen da se ne zažene samodejno kot zagon.
Projekt lahko prenesete v popolno slikovno iskanje v VB6.
Ko kliknete sliko, se v sporočilu prikaže številka in celotna pot do slike.
Prav tako lahko spremenite filtre, da omogočite prikaz drugih slik.

Projekt vsebuje OCX po meri in DLL, morate:

Razširite mapo.
Ne kliknite na projekt, pojdite na ikono VB6, desno kliknite na ikono in odprite kot skrbnik.
Ob otvoritvi kliknite na 'Obstoječe' in odprite projekt LN_Explorateur.vpb
Spremenite širino drevesnega pogleda tako, da premaknete rdečo črto (kliknite na vrstico in premaknite).
- Spremenite velikost sličic s tipko 'S'.

Prikaz slike se izvaja z Gdi + dll, zmanjšanim na najpreprostejši izraz.

Mislim, da se lahko rutina enostavno prenese na VB.Net

Koda

Možnost Eksplicitna

 Sub Initialise_TreeDir (TreeDir kot TreeView) Dim ExpDr, Rep, Drv, S kot niz, N, D, a, r, Unite Dim Cle kot niz, sCle kot niz, Num kot celo število, Sr kot celo število Dim nodX Kot vozlišče Num = 64 Nastavi ExpDr = CreateObject ("Scripting.FileSystemObject") Nastavite Drv = ExpDr.Drives za vsak D v Drv S = D.DriveLetter '& ":" Če je D.DriveType = 3 Potem "r. = 1 Nato "DD externe N =" - Média amovible - ("& D.VolumeName &") "Incr Num: Cle = SS = S &": "Nastavi nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Potem 'DD N = D.VolumeName Incr Num: Cle = SS = S & ":" Nastavi nodX = TreeDir.Nodes.Add (,, Cle, S & "- (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Potem "Napaka DVD-ja nadaljuje Naprej N = D.VolumeName Če je Err = 71 Potem N =" Lecteur DVD - (vide) "Else N =" DVD predvajalnika - ("& N &") "End If Incr Num: Cle = Chr (Num) &" 0 "S = S &": "" Nastavi nodX = TreeDir.Nodes .Dodaj (,, Cle, S & N, 3) Else Stop End Če je S = "" D = "" Naslednji niz nodX = Nič ne nastavi ExpDr = Nič ni nastavljen Drv = nič ne konča Sub sub AjoutRep (Chem As String, Cle kot niz, TreeDir kot TreeView) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle kot niz, Num kot celo število, Sr Kot Integer Dim nodX Kot Node Dim NbsR Kot Integer, S Kot Niz Sr = 9 Chem = Chem & IIf (Desno (Chem, 1) = ", " ", " "" Nastavi Obj = CreateObject ("Scripting") .FileSystemObject ") Set Rep = Obj.Getfolder (Chem) Če je levo (Rep.Name, 1) =" $ "Potem GoTo Passe2 Nastavi sRep = Rep.subfolders za vsak sRp V sRep S = UCase (sRp.Name) Če je levo (S, 1) = "$" Ali S = "WINDOWS" Ali sRp.Attributes> 100 Ali sRp.Attributes = 19 _ Ali levo (S, 6) = "SISTEM" Ali levo (S, 7) = "PROGRAM" Ali levo (S, 4) = "UPORABNIK" _ Ali levo (S, 6) = "DRIVER" Ali levo (S, 5) = "ORODJA" Potem GoTo Passe On Error Nadaljuj naslednjo nastavitev sR2 = sRp.subfolders NbsR = sR2 .Count Če je Err 0 Potem Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "" Na napaki GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCle Set nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Če NbsR> 0 Nato AjoutRep sRp.Path, sCle, TreeDir End če Passe: Next Passe2: Nastavi Obj = Nič Set Rep = Nič ne nastavi sRep = Nič ne nastavi nodX = Nič ne nastavi sR2 = Nič ne konča Pod