VB - Isi TreeView dengan cakera sistem dan direktori mereka

Berikut adalah rutin yang boleh mengisi TreeView dengan cakera sistem dan direktori mereka.

Penerangan

Masalahnya adalah untuk mencari kekunci nod, seperti yang kadang-kadang satu kunci diterbitkan dua kali, maka saya mendapat penyelesaian:

  • Gunakan laluan penuh sebagai kunci dan dengan cara ini, pasti bahawa tidak akan ada pendua.
  • Saya tidak dapat menguji pemacu rangkaian
  • Saya menghilangkan direktori sistem, matlamat saya adalah untuk membuat imej meneroka (tersedia untuk dimuat turun).
  • Rutin ini adalah rekursif dan agak pendek.
  • Jangan terkejut berapa lama (bergantung kepada sistem anda), tapi rutinnya hampir secepat Windows Explorer kecuali ia tidak dilancarkan secara automatik sebagai permulaan.
  • Anda boleh memuat turun projek pengekalan imej lengkap dalam VB6.
  • Apabila anda mengklik pada imej, mesej memaparkan Nombor dan laluan penuh ke imej.
  • Anda juga boleh menukar penapis untuk membolehkan paparan imej lain.

Projek ini mengandungi adat OCX dan DLL, anda mesti:

  • Unzip folder itu.
  • Jangan klik pada projek, navigasi ke ikon VB6, klik kanan pada ikon dan buka sebagai pentadbir.
  • Pada pembukaan, klik pada 'Sedia' dan buka projek LN_Explorateur.vpb
  • Ubah suai lebar TreeView dengan memindahkan garis merah (klik pada baris dan bergerak).
    • Tukar saiz lakaran kecil dengan kekunci 'S'.

Paparan imej dilakukan dengan Gdi + dll dikurangkan kepada ekspresi yang paling sederhana.

  • Saya fikir rutin boleh dengan mudah dialihkan kepada VB.Net

Kod

Pilihan Eksplisit

 Sub Initialise_TreeDir (TreeDir As TreeView) Dim ExpDr, Rep, Drv, S Sebagai String, N, D, a, r, Unite Dim Cle As String, sCle As String, Num As Integer, Sr As Integer Dim nodX As Node Num = 64 Tetapkan ExpDr = CreateObject ("Scripting.FileSystemObject") Tetapkan Drv = ExpDr.Drives Untuk Setiap D Dalam Drv S = D.DriveLetter '& ":" Jika D.DriveType = 3 Kemudian' reseaux N = D.ShareName ElseIf D.DriveType = 1 Lalu 'DD externe N = "- Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (,, Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Kemudian 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (,, Cle 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Kemudian 'DVD On Ralat Ralat Berikutnya N = D.VolumeName Jika Err = 71 Kemudian N = "Lecteur DVD - (vide) "Else N =" Lecteur DVD - ("& N &") "End Jika Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Set nodX = TreeDir.Nodes .Add (,, Cle, S & N, 3) Else Stop End Jika S = "" D = "Set Seterusnya nodX = Tiada Set ExpDr = Tiada Set Drv = Tiada Akhir Sub Sub AjoutRep (Chem As String, Cle As String, TreeDir As TreeView) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle As String, , Sebagai Integer Dim nodX Sebagai Nod Dim NbsR Sebagai Integer, S Sebagai String Sr = 9 Chem = Chem & IIf (Kanan (Chem, 1) = "\", "", "\") Set Obj = CreateObject ("Scripting Setel Rep = Obj.Getfolder (Chem) Jika Kiri (Rep.Name, 1) = "$" Kemudian GoTo Passe2 Set sRep = Rep.subfolders Untuk Setiap sRp Dalam sRep S = UCase (sRp.Name) Jika Kiri (S, 1) = "$" Atau S = "WINDOWS" Atau sRp.Atributes> 100 Atau sRp.Attributes = 19 _O Kiri (S, 6) = "SYSTEM" Atau Kiri (S, 4) = "PENGGUNA" _ Atau Kiri (S, 6) = "PEMASANGAN" Atau Kiri (S, 5) = "TOOLS" Kemudian Kesalahan GoTo Passe On Resume Seterusnya sR2 = sRp.subfolders NbsR = sR2 .Count Jika Err 0 Kemudian Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" On Error GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCp SetNodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Jika NbsR> 0 Kemudian AjoutRep sRp.Path, sCle, TreeDir End Jika Passe: Next Passe2: Set Obj = = Tiada Set sRep = Tiada Set nodX = Tiada Set sR2 = Tiada Sub Akhir 

Muat turun

  • Link1
  • Link2

Kredit

Artikel Sebelumnya Artikel Seterusnya

Tip-Tip Utama