VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form browse 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   3360
      Top             =   1680
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   14
      MaskColor       =   16777215
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Browse.frx":0000
            Key             =   "OrdnerOffen"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Browse.frx":02F2
            Key             =   "OrdnerZu"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   2295
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   2895
      _ExtentX        =   5106
      _ExtentY        =   4048
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
End
Attribute VB_Name = "browse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' TreeView mit allen Ordnern eines Laufwerks füllen
Public Sub FillTreeView(ByVal StartPath As String)
  Dim DirName As String
  Dim I As Integer
  Dim sPos As Integer
  Dim Ordner As String
  Dim MainOrdner As String
  
  ' TreeView löschen
  With TreeView1
    .Nodes.Clear
    
    ' Verzeichnisse ermitteln
    If Right$(StartPath, 1) = ":" Then _
      StartPath = StartPath + "\"
    GetAllFolders StartPath
        
    ' Erster Eintrag: Laufwerk selbst
    .Nodes.Add , , StartPath, StartPath, 3, 3
    
    ' Verzeichnisse
    While List1.ListCount > 0
      DirName = List1.List(0)
      List1.RemoveItem 0
      
      sPos = InStrRev(DirName, "\")
      Ordner = Mid$(DirName, sPos + 1)
      MainOrdner = Left$(DirName, sPos - 1)
      If InStr(MainOrdner, "\") = 0 Then _
        MainOrdner = MainOrdner + "\"
      
      .Nodes.Add MainOrdner, tvwChild, DirName, Ordner, 1, 2
    Wend
  
    ' Root öffnen
    .Nodes(1).Expanded = True
    
  End With
End Sub

' Rekursive Prozedur zum Ermitteln aller Verzeichnisse
Private Sub GetAllFolders(ByVal Pfad As String)
  Dim Count As Long
  Dim I As Long
  Dim DirName() As String

  On Local Error Resume Next
  Count = GetAllSubDir(Pfad, DirName())
  I = 1
  Do Until I > Count
    List1.AddItem Pfad + DirName(I)
    GetAllFolders Pfad + DirName(I) + "\"
    I = I + 1
  Loop
  On Local Error GoTo 0
End Sub

' Unterverzeichnisse eines Ordners ermitteln
Private Function GetAllSubDir(Path As String, _
  D() As String) As Integer
  
  Dim DirName As String
  Dim Count As Integer
  
  If Right$(Path, 1) <> "\" Then Path = Path + "\"
  DirName = Dir(Path, vbDirectory)
  Count = 0
  Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      If (GetAttr(Path + DirName) And vbDirectory) = _
        vbDirectory Then
        If (Count Mod 10) = 0 Then
          ReDim Preserve D(Count + 10) As String
        End If
        Count = Count + 1
        D(Count) = DirName
      End If
    End If
    DirName = Dir
  Loop
  GetAllSubDir = Count
End Function

Private Sub Command1_Click()
  Screen.MousePointer = 11
  ' aktuelles Laufwerk
  FillTreeView Left$(CurDir$, 2)
  Screen.MousePointer = 0
End Sub


