VB - Isi TreeView dengan disk sistem dan direktori mereka

Berikut ini adalah rutin yang dapat mengisi TreeView dengan disk sistem dan direktori mereka.

Deskripsi

Masalahnya adalah menemukan kunci node, karena terkadang kunci diterbitkan dua kali, maka saya menemukan solusinya:

Gunakan path lengkap sebagai kunci dan dengan cara ini, sudah pasti tidak akan ada duplikat.
Saya tidak dapat menguji drive jaringan
Saya menghilangkan direktori sistem, tujuan saya adalah membuat penjelajahan gambar (tersedia untuk diunduh).
Rutin bersifat rekursif dan relatif singkat.
Jangan kaget berapa lama (tergantung sistem Anda), tetapi rutinitasnya hampir secepat Windows Explorer, kecuali itu tidak secara otomatis diluncurkan sebagai startup.
Anda dapat mengunduh proyek eksploer gambar lengkap di VB6.
Ketika Anda mengklik pada suatu gambar, pesan menampilkan angka dan path lengkap ke gambar.
Anda juga dapat mengubah filter untuk memungkinkan tampilan gambar lain.

Proyek ini berisi OCX dan DLL kustom, Anda harus:

Buka zip folder.
Jangan klik pada proyek, arahkan ke ikon VB6, klik kanan pada ikon dan buka sebagai administrator.
Pada pembukaan, klik pada 'Yang Ada' dan buka proyek LN_Explorateur.vpb
Ubah lebar TreeView dengan memindahkan garis merah (klik pada garis dan pindah).
- Ubah ukuran thumbnail dengan tombol 'S'.

Tampilan gambar dilakukan dengan Gdi + dll dikurangi menjadi ekspresi yang paling sederhana.

Saya pikir rutin dapat dengan mudah dipindahkan ke VB.Net

Kode

Opsi Eksplisit

 Sub Initialise_TreeDir (TreeDir As TreeView) Dim ExpDr, Rep, Drv, S As String, N, D, a, r, Unite Dim Cle As String, sCle As String, sCle As String, Num As Integer, Sr As Integer Dim nodX As Node Num = 64 Set ExpDr = CreateObject ("Scripting.FileSystemObject") Set Drv = ExpDr.Drives Untuk Setiap D Dalam Drv S = D.DriveLetter '& ":" Jika D.DriveType = 3 Lalu' réseaux 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 Lalu '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 Kemudian 'DVD On Error Lanjutkan Selanjutnya N = D.VolumeName Jika Err = 71 Lalu N = "DVD Dosen - (vide) "Lain N =" DVD Dosen - ("& N &") "Akhiri Jika Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Set nodX = TreeDir.Nodes .Tambahkan (,, Cle, S & N, 3) Lain Berhenti Berakhir Jika S = "" D = "" Set Berikutnya nodX = Tidak Ada Set ExpDr = Tidak Ada Set Drv = Tidak Ada 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 Sebagai Integer Dim nodX Sebagai Node Dim NbsR Sebagai Integer, S As String Sr = 9 Chem = Chem & IIf (Kanan (Chem, 1) = "\", "", "\") Set Obj = CreateObject ("Scripting .FileSystemObject ") Set Rep = Obj.Getfolder (Chem) Jika Kiri (Rep.Name, 1) =" $ "Kemudian GoTo Passe2 Set sRep = Rep.subfolders Untuk Setiap sRp Di sRep S = UCase (sRp.Name) Jika Kiri (S, 1) = "$" Atau S = "WINDOWS" Atau sRp.Attributes> 100 Atau sRp.Attributes = 19 _ Atau Kiri (S, 6) = "SYSTEM" Atau Kiri (S, 7) = "PROGRAM" Atau Kiri (S, 4) = "PENGGUNA" _ Atau Kiri (S, 6) = "DRIVER" Atau Kiri (S, 5) = "ALAT" Kemudian Lanjutkan Ke Galat Lanjutkan Lanjutkan Set Berikutnya sR2 = sRp.subfolders NbsR = sR2 .Jumlah Jika Kesalahan 0 Lalu Kesalahan = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" Pada Kesalahan GoTo 0 'Debug.Print sRp.Name; ""; Cle; ""; sCle Set nodX = TreeDir.Nodes.Add (Cle, tvwChild, sCle, sRp.Name, 5, 4) Jika NbsR> 0 Kemudian AjoutRep sRp.Path, sCle, TreeDir End Jika Passe: Passe2 berikutnya: Set Obj = Nothing Set Rep = Nothing Set sRep = Nothing Set nodX = Nothing Set sR2 = Nothing End Sub