VB - Заповніть TreeView системними дисками та їх каталогами

Ось процедура, яка може заповнити TreeView системними дисками та їх каталогами.

Опис

Проблема полягала в тому, щоб знайти ключ для вузлів, оскільки іноді ключ був опублікований двічі, то я знайшов рішення:

Використовуйте повний шлях як ключ, і таким чином, безсумнівно, не буде дублікатів.
Я не зміг перевірити мережеві диски
Я виключив системні каталоги, моя мета - зробити зображення досліджуваним (доступним для завантаження).
Процедура є рекурсивною і відносно короткою.
Не дивуйтеся, скільки часу триває (залежно від вашої системи), але процедура майже така ж швидка, як Windows Explorer, за винятком того, що вона не запускається автоматично як запуск.
Ви можете завантажити проект повним зображенням в VB6.
При натисканні на зображення у повідомленні відображається номер і повний шлях до зображення.
Також можна змінити фільтри, щоб дозволити відображення інших зображень.

Проект містить користувацькі OCX і DLL, необхідно:

Розпакуйте папку.
Не натискайте на проект, перейдіть до піктограми VB6, клацніть правою кнопкою миші на значку і відкрийте її як адміністратор.
На відкритті натисніть кнопку "Existing" і відкрийте проект LN_Explorateur.vpb
Змініть ширину TreeView, перемістивши червону лінію (клацніть на лінії і перемістіть).
- Змініть розмір мініатюр за допомогою клавіші 'S'.

Відображення зображення виконується за допомогою Gdi + dll, зведеного до найпростішого виразу.

Я думаю, що рутина може бути легко перенесена на VB.Net

Код

Опція Явна

 Sub Initialise_TreeDir (TreeDir як TreeView) Dim ExpDr, Rep, Drv, S як рядок, N, D, a, r, об'єднати Dim Cle як рядок, sCle як рядок, число як ціле, Sr як ціле Dim nodX як вузол Num = 64 Встановити ExpDr = CreateObject ("Scripting.FileSystemObject") Встановити Drv = ExpDr.Drives для кожного D в Drv S = D.DriveLetter '& ":" Якщо D.DriveType = 3 Тоді' n N = D.ShareName ElseIf D.DriveType = 1 Тоді 'DD externe N = "- Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ":" Встановити nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Потім 'DD N = D.VolumeName Incr Num: Cle = SS = S & ":" Встановити nodX = TreeDir.Nodes.Add (,, Cle, S & "- (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Потім "DVD On Error Поновити далі N = D.VolumeName If Err = 71 Тоді N =" Lecteur DVD - (vide) "Ще N =" Lecteur DVD - ("& N &") "Кінець, якщо Incr Num: Cle = Chr (Num) &" 0 "S = S &": - "Встановити nodX = TreeDir.Nodes .Додати (,, Cle, S & N, 3) Інакше зупинка, якщо S = "" D = "" Наступний набір nodX = Ніщо не встановлено ExpDr = Нічого не встановлено Drv = Нічого не закінчується Sub Sub AjoutRep (Chem як рядок, як рядок Cle, рядок дерева як дерево) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle як рядок, Num як ціле, Sr As Integer Dim nodX Як вузол Dim NbsR Як ціле число, S як рядок Sr = 9 Chem = Chem & IIf (Право (Chem, 1) = ", " ", " "" "Set Obj = CreateObject (" Сценарії .FileSystemObject ") Встановити Rep = Obj.Getfolder (Chem) Якщо ліворуч (Rep.Name, 1) =" $ "Тоді GoTo Passe2 Встановити sRep = Rep.subfolders для кожного sRp в sRep S = UCase (sRp.Name) Якщо ліворуч (S, 1) = "$" Або S = "WINDOWS" Або sRp.Attributes> 100 Або sRp.Attributes = 19 _ Або Ліворуч (S, 6) = "SYSTEM" Або Left (S, 7) = "ПРОГРАМА" Або Ліворуч (S, 4) = "КОРИСТУВАЧ" _ Або Ліворуч (S, 6) = "ДРАЙВЕР" Або Ліворуч (S, 5) = "ІНСТРУМЕНТИ" Потім GoTo Passe On Error Resume Next Set sR2 = sRp.subfolders NbsR = sR2 .Count If Err 0 Тоді Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "" На помилку GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCle Set nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Якщо NbsR> 0 Тоді AjoutRep sRp.Path, sCle, TreeDir End Якщо Passe: Next Passe2: Set Obj = Nothing Set Rep = Ніщо не встановлено sRep = Нічого не встановлено nodX = Нічого не встановлено sR2 = Нічого не закінчується Sub