home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch11 / dirmap / dirmap.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-05-21  |  7.5 KB  |  241 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
  3. Begin VB.Form DirMapForm 
  4.    Caption         =   "Directory Map"
  5.    ClientHeight    =   5625
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   8250
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   5625
  11.    ScaleWidth      =   8250
  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            =   75
  25.       TabIndex        =   4
  26.       Top             =   105
  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            =   2745
  41.       TabIndex        =   3
  42.       Top             =   120
  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            =   5940
  58.       TabIndex        =   2
  59.       Top             =   975
  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            =   6000
  74.       TabIndex        =   1
  75.       Top             =   120
  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            =   75
  91.       TabIndex        =   0
  92.       Top             =   885
  93.       Visible         =   0   'False
  94.       Width           =   2430
  95.    End
  96.    Begin RichTextLib.RichTextBox RichTextBox1 
  97.       Height          =   3450
  98.       Left            =   45
  99.       TabIndex        =   5
  100.       Top             =   2085
  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            =   60
  131.       TabIndex        =   6
  132.       Top             =   1680
  133.       Width           =   6480
  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. '  ******************************
  141. '  ******************************
  142. '  ** MASTERING VB6            **
  143. '  ** by Evangelos Petroutos   **
  144. '  ** SYBEX, 1998              **
  145. '  ******************************
  146. '  ******************************
  147. Option Explicit
  148. Dim InitialFolder As String
  149. Dim totalFolders As Long, totalFiles As Long
  150. Dim currentDepth As Integer
  151. Dim DirStructure As String
  152. Dim T1 As Long
  153. Const newLine = "{\par }"
  154. Function DoubleSlashes(txt As String) As String
  155. Dim k As Integer
  156. Dim newtxt As String
  157.     For k = 1 To Len(txt)
  158.         If Mid$(txt, k, 1) = "\" Then
  159.             newtxt = newtxt & "\\"
  160.         Else
  161.             newtxt = newtxt & Mid$(txt, k, 1)
  162.         End If
  163.     Next
  164.     DoubleSlashes = newtxt
  165. End Function
  166. Private Sub Command1_Click()
  167. 'T1 = Timer
  168.     totalFiles = 0
  169.     totalFolders = 0
  170.     currentDepth = 1
  171.     InitialFolder = CurDir
  172.     DirStructure = "{"
  173.     DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(-1)) & "}" + newLine
  174.     Screen.MousePointer = vbHourglass
  175.     ScanFolders
  176.     DirStructure = DirStructure & "}"
  177.     RichTextBox1.TextRTF = DirStructure
  178.     Label1.Caption = "Scanned " & totalFolders & " folders containing " & totalFiles & " files"
  179.     Screen.MousePointer = vbDefault
  180. 'MsgBox Timer - T1
  181. End Sub
  182. Sub ScanFolders()
  183. Dim subFolders As Integer
  184. Dim txtLine As String
  185. Dim i As Integer, j As Integer
  186.     txtLine = ""
  187.     For j = 0 To File1.ListCount - 1
  188.         txtLine = txtLine & Space(currentDepth * 5) + File1.List(j) & newLine
  189.     Next
  190.     totalFiles = totalFiles + File1.ListCount
  191.     DirStructure = DirStructure & txtLine
  192.     subFolders = Dir2.ListCount
  193.     If subFolders > 0 Then
  194.         currentDepth = currentDepth + 1
  195.         For i = 0 To subFolders - 1
  196. 'msgbox "moving from " & CurDir & " to " & Dir2.List(i)
  197.             DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(i)) & "}" & newLine
  198.             File1.Path = Dir2.List(i)
  199.             ChDir CurDir
  200.             Dir2.Path = Dir2.List(i)
  201.             ScanFolders
  202.         Next
  203.         totalFolders = totalFolders + subFolders
  204.         Label1.Caption = "Processed " & totalFolders & " folders"
  205.         currentDepth = currentDepth - 1
  206.         DoEvents
  207.     End If
  208.     MoveUp
  209.     File1.Path = Dir2.Path
  210. End Sub
  211. Sub MoveUp()
  212.     If Dir2.List(-1) <> InitialFolder Then
  213.         ChDir Dir2.List(-2)
  214.         Dir2.Path = Dir2.List(-2)
  215.     End If
  216. End Sub
  217. Private Sub Dir1_Change()
  218.     ChDir Dir1.Path
  219.     Dir2.Path = Dir1.Path
  220.     File1.Path = Dir2.Path
  221. End Sub
  222. Private Sub Drive1_Change()
  223.     ChDrive Drive1.Drive
  224.     Dir1.Path = Drive1.Drive
  225.     Dir2.Path = Drive1.Drive
  226. End Sub
  227. Private Sub Form_Load()
  228.     ChDrive App.Path
  229.     ChDir App.Path
  230. End Sub
  231. Private Sub Form_Resize()
  232.     If DirMapForm.Width < 8520 Then
  233.         DirMapForm.Width = 9000
  234.     End If
  235.     If DirMapForm.Height < (RichTextBox1.Top + 3450) Then
  236.         DirMapForm.Height = RichTextBox1.Top + 3450
  237.     End If
  238.     RichTextBox1.Width = DirMapForm.Width - 5 * RichTextBox1.Left
  239.     RichTextBox1.Height = DirMapForm.Height - RichTextBox1.Top - 525
  240. End Sub
  241.