VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form3 
   Caption         =   "Form3"
   ClientHeight    =   5190
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5370
   LinkTopic       =   "Form3"
   ScaleHeight     =   5190
   ScaleWidth      =   5370
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   3840
      TabIndex        =   1
      Top             =   240
      Width           =   1455
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   4695
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   3375
      _ExtentX        =   5953
      _ExtentY        =   8281
      _Version        =   393217
      LineStyle       =   1
      Style           =   7
      Appearance      =   1
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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

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 DirInfo
    DirName     As String
End Type

Private bCancel As Boolean

Private Sub FindDirs(D$, T As TreeView)
    Static bFirstIn As Boolean
    
    If bCancel Then Exit Sub
    
    Dim nx As Node, C$
    Dim N As Integer, Srch$, i As Integer, NewD$
    
    C$ = D$
    If Right$(C$, 1) <> "\" Then C$ = C$ & "\"
    
    If Not bFirstIn Then
        bFirstIn = True
        Set nx = T.Nodes.Add(, , C$, C$)
    End If
    
    Srch$ = C$ & "*.*"
    ReDim Dees(1 To 10) As DirInfo
    Call LoadDirs(Dees(), N, Srch$)
    
    DoEvents
    
    If N Then
        For i = 1 To N
            Set nx = T.Nodes.Add(C$, 4, Dees(i).DirName, LastPath$(Left$(Dees(i).DirName, Len(Dees(i).DirName) - 1)))
        Next
    Else
        Exit Sub
    End If
    
    For i = 1 To N
        NewD$ = RTrim$(Dees(i).DirName)
        Call FindDirs(NewD$, T)
    Next
End Sub

Private Function LastPath$(P$)
    Dim i
    For i = Len(P$) To 1 Step -1
        If Mid$(P$, i, 1) = "\" Then
            LastPath$ = Mid$(P$, i + 1)
            Exit For
        End If
    Next
End Function

Private Sub LoadDirs(D() As DirInfo, N As Integer, Srch$)
    Dim a$, Max As Integer, i As Integer, k As Integer, W32 As WIN32_FIND_DATA, fHandle As Long, lResult As Long
    Dim oPath$
    Max = UBound(D)
    N = 0
    
    oPath$ = Left$(Srch$, Len(Srch$) - Len(LastPath$(Srch$)))
    
    fHandle = FindFirstFile(Srch$, W32)

    If fHandle Then
        Do
            a$ = Left$(W32.cFileName, InStr(W32.cFileName, Chr$(0)) - 1)
            If a$ <> "." And a$ <> ".." And ((W32.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0) Then
                N = N + 1
                If Max < N Then
                    Max = Max + 10
                    ReDim Preserve D(1 To Max) As DirInfo
                End If
                D(N).DirName = oPath$ & a$ & "\"
            End If
            DoEvents
            If bCancel Then Exit Do
            lResult = FindNextFile(fHandle, W32)
        Loop While lResult
        lResult = FindClose(fHandle)
    End If
    
    If bCancel Then Exit Sub

    For i = 1 To N - 1
        For k = i + 1 To N
            If UCase$(D(i).DirName) > UCase$(D(k).DirName) Then
                a$ = D(k).DirName
                D(k).DirName = D(i).DirName
                D(i).DirName = a$
            End If
        Next
    Next
End Sub

Private Sub Command1_Click()
    Static Done
    If Done Then Exit Sub
    Done = True
    bCancel = False
    Command1.Caption = "Cancel"
    Call FindDirs("C:\", TreeView1)
    Command1.Caption = "Fill It!"
    MsgBox "Done!"
    Done = False
End Sub