Option Explicit

Const MAX_PATH = 260
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

Dim bCancel As Boolean

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

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"
' Dim nx As Node
' Set nx = TV.Nodes.Add(, , CurDir$, CurDir$)
Call FindDirs("c:\", TV)
Command1.Caption = "Fill It!"
MsgBox "Done!"
done = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub