"Add New Folder" button in "Folder Browser" for Win 98

[Hack]

PS - I am waiting Hack

Patience my New Delhi friend, is a virtue.

This was written by Matt Hart

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:\", TV)
    Command1.Caption = "Fill It!"
    MsgBox "Done!"
    Done = False
End Sub