Startseite / Tipps / VB 5/6-Tipp 0284: Mit Treeview in Laufwerken browsen

VB 5/6-Tipp 0284: Mit Treeview in Laufwerken browsen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Poject1.vbp  -------------
' Die Komponente 'Microsoft Windows Common Controls 5.0 (SP2) (COMCTL32.OCX)' wird benötigt.

'---------- Anfang Formular "Form1" alias Form.frm ----------
' Steuerelement: Baumansichtsteuerelement "TreeView1"
' Steuerelement: Festplattenauswahlliste "Drive1"
' Steuerelement: Bilderliste "ImageList1"

Option Explicit

Option Compare Text

Private Declare Function FindFirstFile Lib "kernel32" _
        Alias "FindFirstFileA" (ByVal lpFileName As String, _
        lpFindFileData As WIN32_FIND_DATA) As Long
        
Private Declare Function FindNextFile Lib "kernel32" _
        Alias "FindNextFileA" (ByVal hFindFile As Long, _
        lpFindFileData As WIN32_FIND_DATA) As Long
        
Private Declare Function FindClose Lib "kernel32" (ByVal _
        hFindFile As Long) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Const MAX_PATH = 259

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETYPE
  Name As String
  Path As String
End Type

Dim Files() As FILETYPE

Private Sub Form_Load()
  Set TreeView1.ImageList = ImageList1
  
  If LCase(Left$(Drive1.Drive, 2)) <> "c:" Then
    Drive1.Drive = "c:"
  Else
    Call Drive1_Change
  End If
End Sub

Private Sub TreeView1_DblClick()
  Dim Folder$
    Folder = TreeView1.SelectedItem.Key
    Folder = Left$(Folder, Len(Folder) - 1)
    If Len(Folder) > 2 Then
      Call MsgBox("Es wurde der Ordner " & Chr$(34) & Folder _
                   & Chr(34) & " ausgewählt.")
    End If
End Sub

Private Sub TreeView1_Expand(ByVal Node As ComctlLib.Node)
  Dim x&

    With TreeView1
    For x = Node.Child.FirstSibling.Index To _
            Node.Child.LastSibling.Index

      If .Nodes(x).Tag <> "*" Then
        Call GetFiles(.Nodes(x).Key)
        TreeView1.Nodes(x).Tag = "*"
      End If
    Next x
    End With
End Sub

Private Sub Drive1_Change()
  ChDir Left$(Drive1.Drive, 2) & "\"
  Call ReadDrive(Left$(Drive1.Drive, 2) & "\")
End Sub

Private Sub ReadDrive(ByVal Path$)
  Path = UCase(Path)
  TreeView1.Nodes.Clear
  TreeView1.Nodes.Add , , Path, Left$(Path, 2), 1, 1
  Call GetFiles(Path)
  TreeView1.Nodes(1).Expanded = True
End Sub

Private Sub GetFiles(Root$)
  Dim File$, hFile&, FD As WIN32_FIND_DATA, x&

    ReDim Files(0)
    hFile = FindFirstFile(Root & "*.*", FD)
    If hFile = 0 Then Exit Sub
    Do
       File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
       If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
         = FILE_ATTRIBUTE_DIRECTORY Then
         If (File <> ".") And (File <> "..") Then
            Files(UBound(Files)).Name = File
            Files(UBound(Files)).Path = Root & File & "\"
            ReDim Preserve Files(0 To UBound(Files) + 1)
         End If
       End If
    Loop While FindNextFile(hFile, FD)
    Call FindClose(hFile)
 
    If UBound(Files) > 0 Then
      Call QuickSort(0, UBound(Files) - 1)
      For x = 0 To UBound(Files) - 1
        TreeView1.Nodes.Add Root, tvwChild, Files(x).Path, _
                            Files(x).Name, 2, 3
      Next x
    End If
End Sub

Private Sub QuickSort(ByVal LB&, ByVal UB&)
  Dim P1&, P2&, Ref$, TEMP As FILETYPE

    P1 = LB
    P2 = UB
    Ref = Files((P1 + P2) / 2).Name
    
    Do
      Do While (Files(P1).Name < Ref)
        P1 = P1 + 1
      Loop
 
      Do While (Files(P2).Name > Ref)
        P2 = P2 - 1
      Loop

      If P1 <= P2 Then
        TEMP = Files(P1)
        Files(P1) = Files(P2)
        Files(P2) = TEMP
            
        P1 = P1 + 1
        P2 = P2 - 1
      End If
    Loop Until (P1 > P2)

    If LB < P2 Then Call QuickSort(LB, P2)
    If P1 < UB Then Call QuickSort(P1, UB)
End Sub
'----------- Ende Formular "Form1" alias Form.frm -----------
'-------------- Ende Projektdatei Poject1.vbp  --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 10 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.