DOCUMENT:Q189631  17-JUL-1998  [vbwin]
TITLE   :HOWTO: Add the Entire Directory Structure to a RichTextBox
PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:WINDOWS:4.0,5.0
OPER/SYS:WINDOWS
KEYWORDS:

======================================================================
---------------------------------------------------------------------
The information in this article applies to:

 - Microsoft Visual Basic Learning, Professional, and Enterprise Editions
   for Windows, version 4.0, 5.0
---------------------------------------------------------------------

SUMMARY
=======

This article describes two ways to view the contents of a directory tree
from a RichTextBox control.

MORE INFORMATION
================

The following sample program uses a RichTextBox to display the entire
contents of a drive. It is also an example of recursion, the QuickSort
algorithm, and RichTextBox RTF formatting.

Step-by-Step Example
--------------------

1. Start a new Standard EXE project in Visual Basic. Form1 is created by
   default.

2. From the Project menu, select Components, check "Microsoft Common Dialog
   Control" and "Microsoft RichTextBox Control," and then click OK.

3. Add the following controls to Form1:

      4 CommandButton controls
      2 DirListBox controls
      1 DriveListBox control
      1 FileListBox control
      1 CommonDialog control
      1 RichTextBox control

4. Add the following code to the General Declarations section of Form1:

      Option Explicit

      Dim InF As String ' Starting Directory
      Dim DS As String  ' Buffer for RFT control text
      Const nL = "{\par }"

      Function DbS(ByVal txt As String) As String
         Dim k As Long, kLast As Long
         Dim nt As String
         k = 1
         kLast = 1
         Do ' Replace all \ characters with \\
            k = InStr(kLast, txt, "\")
            If k = 0 Then
               Exit Do
            Else
               txt = Left$(txt, k) & Right$(txt, Len(txt) - k + 1)
               kLast = k + 2
            End If
         Loop
         DbS = txt
      End Function

      ' ============================ QuickSort ============================
      ' QuickSort works by picking a random "pivot" element in SortArray,
      ' then moving every element that is bigger to one side of the pivot,
      ' & every element that is smaller to the other side. QuickSort is
      ' then called recursively with the two subdivisions created by the
      ' pivot. Once the number of elements in a subdivision reaches two,
      ' the recursive calls end and the array is sorted.
      ' ===================================================================
      '
      Private Sub QuickSort(SortArray() As String, ByVal Low As Long, _
                         ByVal High As Long)
         Dim I As Long, J As Long, RandIndex As Long, Partition As String
         If Low < High Then
            ' Only two elements in this subdivision; swap them if they are
            ' out of order, then end recursive calls:
            If High - Low = 1 Then
               If UCase(SortArray(Low)) > UCase(SortArray(High)) Then
                  SWAP SortArray(Low), SortArray(High)
               End If
            Else
               ' Pick a pivot element at random, then move it to the end:
               RandIndex = Rnd() * (High - Low) + Low ' RandInt%(Low, High)
               SWAP SortArray(High), SortArray(RandIndex)
               Partition = UCase(SortArray(High))
               Do
                  ' Move in from both sides towards the pivot element:
                  I = Low: J = High
                  Do While (I < J) And (UCase(SortArray(I)) <= Partition)
                     I = I + 1
                  Loop
                  Do While (J > I) And (UCase(SortArray(J)) >= Partition)
                     J = J - 1
                  Loop

                  ' If we haven't reached the pivot element it means that 2
                  ' elements on either side are out of order, so swap them:
                  If I < J Then
                     SWAP SortArray(I), SortArray(J)
                  End If
               Loop While I < J

               ' Move the pivot element to its proper place in the array:
               SWAP SortArray(I), SortArray(High)

               ' Recursively call the QuickSort procedure (pass the
               ' smaller subdivision first to use less stack space):
               If (I - Low) < (High - I) Then
                  QuickSort SortArray, Low, I - 1
                  QuickSort SortArray, I + 1, High
               Else
                  QuickSort SortArray, I + 1, High
                  QuickSort SortArray, Low, I - 1
               End If
            End If
         End If
      End Sub

      Private Sub ScanFoldersC(cD As Integer)
         Dim subFolders As Integer
         Dim tL As String
         Dim J As Integer
         Dim I As Long

         tL = ""
         For J = 0 To File1.ListCount - 1
            DoEvents
            tL = tL & Space(cD * 5) + File1.List(J) & nL
         Next
         DS = DS & tL
         subFolders = Dir2.ListCount
         If subFolders > 0 Then
            For I = 0 To subFolders - 1
               DoEvents
               DS = DS & "{\b " & DbS(Dir2.List(I)) & "}" & nL
               File1.path = Dir2.List(I)
               ChDir CurDir    'Dir2.List(i)
               Dir2.path = Dir2.List(I)
               Call ScanFoldersC(cD + 1)
            Next
            DoEvents
         End If
         '        MoveUp
         If Dir2.List(-1) <> InF Then
            ChDir Dir2.List(-2)
            Dir2.path = Dir2.List(-2)
         End If
         File1.path = Dir2.path
      End Sub

      Private Sub ScanFoldersD(path$, cD As Integer)
         Dim tL As String     ' temporary buffer for filenames
         Dim tPath As String  ' temporary path string
         Dim I As Integer     ' loop index
         Dim sd$(0 To 100)    ' array of subdirectories
         Dim nDir As Integer  ' # of subdirectories in sd$
         Dim sf() As String   ' array of files in directory
         Dim nFile As Integer ' # of files in sf
         ReDim sf(1 To 256)

         tL = ""
         nDir = 0
         nFile = 0
         sd$(0) = Dir$(".", vbDirectory)
         While sd$(nDir) <> ""
            If (GetAttr(sd$(nDir)) And vbDirectory) <> 0 Then
               If Left$(sd$(nDir), 1) <> "." Then
                  nDir = nDir + 1
               End If
            Else
            ' add the item to the list
               nFile = nFile + 1
               sf(nFile) = sd$(nDir)
               If nFile Mod 256 = 0 Then
                  ReDim Preserve sf(1 To UBound(sf) + 256)
               End If
            End If
            sd$(nDir) = Dir()
         Wend
         nDir = nDir - 1
         Call QuickSort(sd$, 0, nDir)
         Call QuickSort(sf, 1, nFile)
         For I = 1 To nFile
             tL = tL & Space(cD * 5) + sf(I) & nL
         Next I
         DS = DS & tL

         If nDir >= 0 Then
            For I = 0 To nDir
               tPath = path$ & "\" & sd$(I)
               DS = DS & "{\b " & DbS(tPath) & "}" & nL
               ChDir tPath
               Call ScanFoldersD(tPath, cD + 1)
            Next I
         End If
      End Sub
      Private Sub SWAP(first As String, second As String)
         Dim temp As String
         temp = first
         first = second
         second = temp
      End Sub

      Private Sub Command1_Click()
         InF = CurDir
         MsgBox "This program is about to go through the entire " & InF & _
         " ,please be patient."
         DS = "{{\b " & DbS(Dir1.List(-1)) & "}" + nL
         Call ScanFoldersC(1)
         DS = DS & "}"
         RichTextBox1.TextRTF = DS
      End Sub

      Private Sub Command2_Click()
         InF = CurDir
         MsgBox "This program is about to go through the entire " & InF & _
         " ,please be patient."
         DS = "{{\b " & DbS(InF) & "}" + nL
         Call ScanFoldersD(InF, 1)
         DS = DS & "}"
         RichTextBox1.TextRTF = DS
      End Sub

      Private Sub Command3_Click()
         RichTextBox1.TextRTF = ""
         CommonDialog1.ShowOpen
         If CommonDialog1.filename <> "" Then _
         RichTextBox1.filename = CommonDialog1.filename
      End Sub

      Private Sub Command4_Click()
         CommonDialog1.Filter = "*.RTF|*.RTF"
         CommonDialog1.filename = ""
         CommonDialog1.ShowSave
         On Error Resume Next
         If CommonDialog1.filename <> "" Then _
         RichTextBox1.SaveFile CommonDialog1.filename
      End Sub

      Private Sub Dir1_Change()
         File1.filename = Dir1.path
      End Sub

      Private Sub Drive1_Change()
         Dir1.path = Drive1.Drive
      End Sub

      Private Sub Form_Load()
         Dir1.Visible = False
         Drive1.Visible = False
         Dir2.Visible = False
         File1.Visible = False
         Form1.Visible = True
         Command1.Caption = "Directory View Method A"
         Command2.Caption = "Directory View Method B"
         Command3.Caption = "Open"
         Command4.Caption = "Save"
      End Sub

5. Run the program. Click either of the Directory View CommandButtons and
   observe the effect. If your current directory is the root, the task may
   take some time to complete.

   NOTE: Name Spaces and other pseudo directory structures such as the
   Internet temp directories may not be displayed using these methods.

REFERENCES
==========

For more information about the RichTextBox control, search Help for
RichTextBox.

For additional information on listing or searching for files, please see
the following articles in the Microsoft Knowledge Base:

   ARTICLE-ID: Q185476
   TITLE     : HOWTO: Search Directories to Find or List Files

   ARTICLE-ID: Q185601
   TITLE     : HOWTO: Recursively Search Directories Using FileSystemObject

Additional query words: kbDSupport kbDSD kbVBp kbVBp400 kbVBp500 kbCtrl
(c) Microsoft Corporation 1998. All Rights Reserved.
Contributions by Richard T. Edwards, Microsoft Corporation
======================================================================
Version           : WINDOWS:4.0,5.0
Platform          : WINDOWS
Issue type        : kbhowto

=============================================================================

THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS
PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND.  MICROSOFT DISCLAIMS
ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO
EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR
ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL,
CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF
MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.  SOME STATES DO NOT ALLOW THE EXCLUSION
OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES
SO THE FOREGOING LIMITATION MAY NOT APPLY.

Copyright Microsoft Corporation 1998.