home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch12 / dirmap / dirmap.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-07-03  |  7.3 KB  |  234 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form DirMapForm 
  4.    Caption         =   "Directory Map"
  5.    ClientHeight    =   6000
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   8400
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   6000
  11.    ScaleWidth      =   8400
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.DriveListBox Drive1 
  14.       BeginProperty Font 
  15.          Name            =   "Verdana"
  16.          Size            =   8.25
  17.          Charset         =   0
  18.          Weight          =   400
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   315
  24.       Left            =   150
  25.       TabIndex        =   4
  26.       Top             =   210
  27.       Width           =   2430
  28.    End
  29.    Begin VB.DirListBox Dir1 
  30.       BeginProperty Font 
  31.          Name            =   "Verdana"
  32.          Size            =   8.25
  33.          Charset         =   0
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   1215
  40.       Left            =   2820
  41.       TabIndex        =   3
  42.       Top             =   225
  43.       Width           =   2925
  44.    End
  45.    Begin VB.CommandButton Command1 
  46.       Caption         =   "Map this Folder"
  47.       BeginProperty Font 
  48.          Name            =   "Verdana"
  49.          Size            =   9.75
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   495
  57.       Left            =   6015
  58.       TabIndex        =   2
  59.       Top             =   1170
  60.       Width           =   2205
  61.    End
  62.    Begin VB.DirListBox Dir2 
  63.       BeginProperty Font 
  64.          Name            =   "Verdana"
  65.          Size            =   8.25
  66.          Charset         =   0
  67.          Weight          =   400
  68.          Underline       =   0   'False
  69.          Italic          =   0   'False
  70.          Strikethrough   =   0   'False
  71.       EndProperty
  72.       Height          =   765
  73.       Left            =   6015
  74.       TabIndex        =   1
  75.       Top             =   15
  76.       Visible         =   0   'False
  77.       Width           =   2055
  78.    End
  79.    Begin VB.FileListBox File1 
  80.       BeginProperty Font 
  81.          Name            =   "Verdana"
  82.          Size            =   8.25
  83.          Charset         =   0
  84.          Weight          =   400
  85.          Underline       =   0   'False
  86.          Italic          =   0   'False
  87.          Strikethrough   =   0   'False
  88.       EndProperty
  89.       Height          =   480
  90.       Left            =   150
  91.       TabIndex        =   0
  92.       Top             =   990
  93.       Visible         =   0   'False
  94.       Width           =   2430
  95.    End
  96.    Begin RichTextLib.RichTextBox RichTextBox1 
  97.       Height          =   3450
  98.       Left            =   150
  99.       TabIndex        =   5
  100.       Top             =   2415
  101.       Width           =   8130
  102.       _ExtentX        =   14340
  103.       _ExtentY        =   6085
  104.       _Version        =   393217
  105.       Enabled         =   -1  'True
  106.       ScrollBars      =   3
  107.       RightMargin     =   8e6
  108.       TextRTF         =   $"DirMap.frx":0000
  109.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  110.          Name            =   "Verdana"
  111.          Size            =   9.75
  112.          Charset         =   0
  113.          Weight          =   400
  114.          Underline       =   0   'False
  115.          Italic          =   0   'False
  116.          Strikethrough   =   0   'False
  117.       EndProperty
  118.    End
  119.    Begin VB.Label Label1 
  120.       BeginProperty Font 
  121.          Name            =   "Verdana"
  122.          Size            =   9.75
  123.          Charset         =   0
  124.          Weight          =   400
  125.          Underline       =   0   'False
  126.          Italic          =   0   'False
  127.          Strikethrough   =   0   'False
  128.       EndProperty
  129.       Height          =   315
  130.       Left            =   195
  131.       TabIndex        =   6
  132.       Top             =   2010
  133.       Width           =   5850
  134.    End
  135. Attribute VB_Name = "DirMapForm"
  136. Attribute VB_GlobalNameSpace = False
  137. Attribute VB_Creatable = False
  138. Attribute VB_PredeclaredId = True
  139. Attribute VB_Exposed = False
  140. Option Explicit
  141. Dim InitialFolder As String
  142. Dim totalFolders As Integer, totalFiles As Integer
  143. Dim currentDepth As Integer
  144. Dim DirStructure As String
  145. Dim T1 As Long
  146. Const newLine = "{\par }"
  147. Function DoubleSlashes(txt As String) As String
  148. Dim k As Integer
  149. Dim newtxt As String
  150.     For k = 1 To Len(txt)
  151.         If Mid$(txt, k, 1) = "\" Then
  152.             newtxt = newtxt & "\\"
  153.         Else
  154.             newtxt = newtxt & Mid$(txt, k, 1)
  155.         End If
  156.     Next
  157.     DoubleSlashes = newtxt
  158. End Function
  159. Private Sub Command1_Click()
  160. T1 = Timer
  161.     totalFiles = 0
  162.     totalFolders = 0
  163.     currentDepth = 1
  164.     InitialFolder = CurDir
  165.     DirStructure = "{"
  166.     DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(-1)) & "}" + newLine
  167.     Screen.MousePointer = vbHourglass
  168.     ScanFolders
  169.     DirStructure = DirStructure & "}"
  170.     RichTextBox1.TextRTF = DirStructure
  171.     Label1.Caption = "Scanned " & totalFolders & " folders containing " & totalFiles
  172.     Screen.MousePointer = vbDefault
  173. MsgBox Timer - T1
  174. End Sub
  175. Sub ScanFolders()
  176. Dim subFolders As Integer
  177. Dim txtLine As String
  178. Dim i As Integer, j As Integer
  179.     txtLine = ""
  180.     For j = 0 To File1.ListCount - 1
  181.         txtLine = txtLine & Space(currentDepth * 5) + File1.List(j) & newLine
  182.     Next
  183.     totalFiles = totalFiles + File1.ListCount
  184.     DirStructure = DirStructure & txtLine
  185.     subFolders = Dir2.ListCount
  186.     If subFolders > 0 Then
  187.         currentDepth = currentDepth + 1
  188.         For i = 0 To subFolders - 1
  189. 'msgbox "moving from " & CurDir & " to " & Dir2.List(i)
  190.             DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(i)) & "}" & newLine
  191.             File1.Path = Dir2.List(i)
  192.             ChDir CurDir
  193.             Dir2.Path = Dir2.List(i)
  194.             ScanFolders
  195.         Next
  196.         totalFolders = totalFolders + subFolders
  197.         Label1.Caption = "Processed " & totalFolders & " folders"
  198.         currentDepth = currentDepth - 1
  199.         DoEvents
  200.     End If
  201.     MoveUp
  202.     File1.Path = Dir2.Path
  203. End Sub
  204. Sub MoveUp()
  205.     If Dir2.List(-1) <> InitialFolder Then
  206.         ChDir Dir2.List(-2)
  207.         Dir2.Path = Dir2.List(-2)
  208.     End If
  209. End Sub
  210. Private Sub Dir1_Change()
  211.     ChDir Dir1.Path
  212.     Dir2.Path = Dir1.Path
  213.     File1.Path = Dir2.Path
  214. End Sub
  215. Private Sub Drive1_Change()
  216.     ChDrive Drive1.Drive
  217.     Dir1.Path = Drive1.Drive
  218.     Dir2.Path = Drive1.Drive
  219. End Sub
  220. Private Sub Form_Load()
  221.     ChDrive App.Path
  222.     ChDir App.Path
  223. End Sub
  224. Private Sub Form_Resize()
  225.     If DirMapForm.Width < 8520 Then
  226.         DirMapForm.Width = 9000
  227.     End If
  228.     If DirMapForm.Height < (RichTextBox1.Top + 3450) Then
  229.         DirMapForm.Height = RichTextBox1.Top + 3450
  230.     End If
  231.     RichTextBox1.Width = DirMapForm.Width - 2 * RichTextBox1.Left
  232.     RichTextBox1.Height = DirMapForm.Height - RichTextBox1.Top - 525
  233. End Sub
  234.