home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / misc / samples2 / getdirs.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-24  |  5.0 KB  |  166 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Find Directories"
  4.    ClientHeight    =   6315
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1770
  7.    ClientWidth     =   6990
  8.    Height          =   7005
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6315
  12.    ScaleWidth      =   6990
  13.    Top             =   1140
  14.    Width           =   7110
  15.    Begin TextBox Text1 
  16.       Height          =   360
  17.       Left            =   465
  18.       TabIndex        =   1
  19.       Text            =   "Text1"
  20.       Top             =   1305
  21.       Width           =   2295
  22.    End
  23.    Begin CommandButton Command1 
  24.       Caption         =   "&Search"
  25.       Default         =   -1  'True
  26.       Height          =   510
  27.       Left            =   4560
  28.       TabIndex        =   2
  29.       Top             =   1155
  30.       Width           =   1860
  31.    End
  32.    Begin ListBox List1 
  33.       Height          =   3930
  34.       Left            =   480
  35.       Sorted          =   -1  'True
  36.       TabIndex        =   0
  37.       Top             =   1755
  38.       Width           =   5940
  39.    End
  40.    Begin Label Label2 
  41.       Height          =   885
  42.       Left            =   495
  43.       TabIndex        =   4
  44.       Top             =   105
  45.       Width           =   5955
  46.    End
  47.    Begin Label Label1 
  48.       Caption         =   "Label1"
  49.       Height          =   315
  50.       Left            =   495
  51.       TabIndex        =   3
  52.       Top             =   5820
  53.       Width           =   5355
  54.    End
  55.    Begin Menu mnuExit 
  56.       Caption         =   "&Exit"
  57.    End
  58. Const ATTR_DIRECTORY = 16
  59. Const ATTR_HIDDEN = 2
  60. Dim directories$()
  61. Dim Index%
  62. Sub Command1_Click ()
  63.     'Start fresh
  64.     List1.Clear
  65.     Erase directories$
  66.     Index% = 0
  67.     Label1 = "Searching...Please Wait."
  68.     'Change cursor to hourglass
  69.     Screen.MousePointer = 11
  70.     'Start the search
  71.     SearchDir
  72.     'change cursor back to default
  73.     Screen.MousePointer = 0
  74. End Sub
  75. Sub Form_Load ()
  76.     Text1 = "C:\VB"
  77.     Label1 = ""
  78.     msg$ = "Type in desired directory and press ENTER.  "
  79.     msg$ = msg$ + "The program will then list all subdirectories under "
  80.     msg$ = msg$ + "the specified directory.  For example, to list ALL "
  81.     msg$ = msg$ + "subdirectories on the hard drive, type ""C:\"""
  82.     Label2 = msg$
  83.     Me.Show
  84.     Text1.SelStart = 0
  85.     Text1.SelLength = Len(Text1)
  86.     Text1.SetFocus
  87. End Sub
  88. Sub Form_Unload (Cancel As Integer)
  89.     End
  90. End Sub
  91. Sub ListSubDirs (Path$)
  92. 'local variable to store the number of directories found in each call to this sub
  93. Dim Count%
  94. 'local array to store the directory names found in each call to this sub
  95. Dim Direct$()
  96. Dim I%
  97. Dim DirName$
  98. On Error GoTo SubDirsError
  99.     DoEvents
  100.     'Get the first directory name
  101.     DirName$ = Dir(Path$ & "\", ATTR_DIRECTORY + ATTR_HIDDEN)' Get first directory name.
  102.     'repeatedly go through PATH$
  103.     Do While (DirName$ <> "") And (ErrorOccured <> True)
  104.         If DirName$ <> "." And DirName$ <> ".." Then
  105.             If (GetAttr(Path$ & "\" & DirName$) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
  106.                 'Increment counter
  107.                 Count% = Count% + 1
  108.                 
  109.                 'Resize the array.
  110.                 ReDim Preserve Direct$(Count%)
  111.                 
  112.                 'Assign directory to local array
  113.                 Direct$(Count%) = DirName$
  114.                 
  115.                 'Increment total number of directories found
  116.                 Index% = Index% + 1
  117.                 
  118.                 'Resize array
  119.                 ReDim Preserve directories$(Index%)
  120.                 
  121.                 'Assign path and directory to modular-scope array
  122.                 directories$(Index%) = Path$ + "\" + DirName$
  123.             End If
  124.         End If
  125.         DirName$ = Dir$   ' Get next directory name.
  126.     Loop
  127.     ' Now recursively iterate through each subdirectory.
  128.     I% = 1
  129.     While (I% <= Count%) And (Not ErrorOccured)
  130.         Call ListSubDirs(Path$ & "\" & Direct$(I%))
  131.         I% = I% + 1
  132.     Wend
  133.     Exit Sub
  134. SubDirsError:
  135.     MsgBox "Error reading subdirectories", 48
  136.     ErrorOccured = True
  137.     Exit Sub
  138. End Sub
  139. Sub mnuExit_Click ()
  140.     Unload Me
  141. End Sub
  142. Sub SearchDir ()
  143. Dim InitialDir$, I%
  144. On Error Resume Next
  145.     'Change to the specified directory
  146.     InitialDir$ = Text1
  147.     ChDir InitialDir$
  148.     If Err Then
  149.         Label1 = ""
  150.         msg$ = "Invalid Directory"
  151.         MsgBox msg$, 48
  152.         Text1.SetFocus
  153.         Exit Sub
  154.     End If
  155.     'Remove any trailing backslash
  156.     If Right$(InitialDir$, 1) = "\" Then
  157.         InitialDir$ = Left$(InitialDir$, Len(InitialDir$) - 1)
  158.     End If
  159.     'Recursively go through the directory tree structure
  160.     Call ListSubDirs(InitialDir$)
  161.     For I% = 1 To Index%
  162.         List1.AddItem UCase$(directories$(I%))
  163.     Next I%
  164.     Label1 = "# of Subdirectories = " & Str$(Index%)
  165. End Sub
  166.