VB - Bir TreeView'ü sistem diskleriyle ve dizinleriyle doldurun

İşte TreeView'ü sistem diskleriyle ve dizinleriyle doldurabilen bir yordam.

Açıklama

Sorun düğümler anahtarını bulmaktı, bazen bir anahtar iki kez yayınlandığından, bir çözüm buldum:

Tam yolu anahtar olarak kullanın ve bu şekilde, yinelenen olmayacağı kesindir.
Ağ sürücülerini test edemedim
Sistem dizinlerini kaldırdım, amacım bir görüntüyü keşfetmek (indirmeye hazır) yapmak.
Rutin özyinelemelidir ve nispeten kısadır.
Ne kadar sürdüğüne şaşırmayın (sisteminize bağlı olarak), ancak rutin neredeyse başlangıç olarak otomatik olarak başlatılmaması haricinde Windows Gezgini kadar hızlı.
Projeyi VB6'da eksiksiz bir görüntü keşfi indirebilirsiniz.
Bir resme tıkladığınızda, mesaj, Numarayı ve resmin tam yolunu görüntüler.
Diğer görüntülerin gösterilmesine izin vermek için filtreleri de değiştirebilirsiniz.

Proje özel bir OCX ve DLL içeriyorsa, şunları yapmanız gerekir:

Klasörü açın.
Projeye tıklamayın, VB6 simgesine gidin, ikona sağ tıklayın ve yönetici olarak açın.
Açılışta, 'Mevcut' üzerine tıklayın ve LN_Explorateur.vpb projesini açın
TreeView'in genişliğini kırmızı çizgiyi hareket ettirerek değiştirin (çizgiyi tıklayın ve taşıyın).
- Küçük resimlerin boyutunu 'S' tuşuyla değiştirin.

Görüntü ekranı, Gdi + dll ile en basit ifadesine indirgenmiş olarak gerçekleştirilir.

Rutinin VB.Net'e kolayca aktarılabileceğini düşünüyorum.

kod

Seçenek Açık

 Sub Initialise_TreeDir (TreeView Olarak TreeDir) Dim ExpDr, Rep, Drv, S Dize, N, D, a, r, Dize Olarak Dim Cle Birleştir, Dize Olarak sCle, Tam Sayı Olarak Num, Sr Tam Sayı Olarak Dim nodX, Düğüm Olarak Num = 64 ExpDr = CreateObject ("Scripting.FileSystemObject") Setini Ayarla Drv = ExpDr.Drives'i Drv'de Ayarlayın S = D.DriveLetter '& ":" Eğer D.DriveType = 3 ise' réseaux N = D.AdıAdı Eğer D.DriveType = = 1 Sonra 'DD externe N = "- Média taşınabilir - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Sonra 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (,, Cle, S & "- (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Ardından 'Arızası Devam Eden DVD Sonraki N = D.VolumeName Err = 71 Ardından N = "Dersi Veren DVD - (vide) "Başka N =" Dersi Veren DVD - ("& N &") "İncr Sayıysa Son: Num = Cle = Chr (Num) &" 0 "S = S &": \ - "nodX = TreeDir.Nodes Ayarla .Add (,, Cle, S & N, 3) S = "" ise Başka Durdurma Sonu D = "" Sonraki Set nodX = Hiçbir Set Değil ExpDr = Set Yok Drv = Hiçbir Şey Bitiş Alt Alt AjoutRep (Dize Olarak Kimya, Dize Olarak Cle, TreeDir olarak Ağaç Görüntüleme) Dim Rep, sRp, Obj, sRep, sR2 Dize Olarak Dim, Dize Olarak Sayı, Num, Sr Tam Sayı Olarak Dim nodX Düğüm Olarak Dim NbsR Tam Sayı Olarak, S Dize Olarak Sr = 9 Chem = Chem & IIf (Sağ (Chem, 1) = "\", "", "\") Set Obj = CreateObject ("Scripting .FileSystemObject ") Set Rep = Obj.Getfolder (Chem) Sola Dönerse (Rep.Name, 1) =" $ "Sonra Go To Passe2 Set sRep = Rep.subfolders sRep İçinde Her sRep S = UCase (sRp.Name) (S, 1) = "$" veya S = "WINDOWS" veya sRp.Atrributes> 100 Veya sRp.Attributes = 19 _ Veya Sol (S, 6) = "SYSTEM" veya Sol (S, 7) = "PROGRAM" Veya Sol (S, 4) = "KULLANICI" _ Veya Sol (S, 6) = "SÜRÜCÜ" veya Sol (S, 5) = "ARAÇ" "Sonra Gitme Hata Sırasında Devam Etme Sıfırla Sonraki Ayarla sR2 = sRp.subfolders NbsR = sR2 .Cr Err 0 ise Err = 0: Go To Passe Incr Sr sCle = sRp.Path & "\" Hata durumunda GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCle Ayarı nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) NbsR> 0 ise AjoutRep sRp.Path, sCle, Passe: TreeDir End: Passe2: Set Obj = Hiçbir Set Set Rep = Hiçbir şey Set sRep = Hiçbir şey Set nodX = Hiçbir şey Set sR2 = Hiçbir şey Son Sub