home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch10 / dirmap / dirmap.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-02-20  |  4.8 KB  |  159 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
  3. Begin VB.Form Form1 
  4.    Caption         =   "Directory Map"
  5.    ClientHeight    =   5820
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   8310
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   5820
  11.    ScaleWidth      =   8310
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.FileListBox File1 
  14.       Height          =   675
  15.       Left            =   165
  16.       TabIndex        =   5
  17.       Top             =   1155
  18.       Visible         =   0   'False
  19.       Width           =   2370
  20.    End
  21.    Begin VB.DirListBox Dir2 
  22.       Height          =   1155
  23.       Left            =   6000
  24.       TabIndex        =   3
  25.       Top             =   150
  26.       Visible         =   0   'False
  27.       Width           =   2055
  28.    End
  29.    Begin VB.CommandButton Command1 
  30.       Caption         =   "Map this Folder"
  31.       Height          =   495
  32.       Left            =   6015
  33.       TabIndex        =   2
  34.       Top             =   1455
  35.       Width           =   2175
  36.    End
  37.    Begin VB.DirListBox Dir1 
  38.       Height          =   1605
  39.       Left            =   2805
  40.       TabIndex        =   1
  41.       Top             =   360
  42.       Width           =   2925
  43.    End
  44.    Begin VB.DriveListBox Drive1 
  45.       Height          =   315
  46.       Left            =   135
  47.       TabIndex        =   0
  48.       Top             =   345
  49.       Width           =   2430
  50.    End
  51.    Begin RichTextLib.RichTextBox RichTextBox1 
  52.       Height          =   3555
  53.       Left            =   90
  54.       TabIndex        =   4
  55.       Top             =   2145
  56.       Width           =   8130
  57.       _ExtentX        =   14340
  58.       _ExtentY        =   6271
  59.       _Version        =   327680
  60.       Enabled         =   -1  'True
  61.       ScrollBars      =   3
  62.       TextRTF         =   $"DirMap.frx":0000
  63.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  64.          Name            =   "Courier New"
  65.          Size            =   9.75
  66.          Charset         =   0
  67.          Weight          =   400
  68.          Underline       =   0   'False
  69.          Italic          =   0   'False
  70.          Strikethrough   =   0   'False
  71.       EndProperty
  72.    End
  73. Attribute VB_Name = "Form1"
  74. Attribute VB_GlobalNameSpace = False
  75. Attribute VB_Creatable = False
  76. Attribute VB_PredeclaredId = True
  77. Attribute VB_Exposed = False
  78. Dim InitialFolder As String
  79. Dim totalFiles As Integer
  80. Dim currentDepth As Integer
  81. Dim DirStructure As String
  82. Const newLine = "{\par }"
  83. Function DoubleSlashes(txt As String) As String
  84.         
  85.     For k = 1 To Len(txt)
  86.         If Mid$(txt, k, 1) = "\" Then
  87.             newtxt = newtxt & "\\"
  88.         Else
  89.             newtxt = newtxt & Mid$(txt, k, 1)
  90.         End If
  91.     Next
  92.     DoubleSlashes = newtxt
  93. End Function
  94. Private Sub Command1_Click()
  95.     totalFiles = 0
  96.     currentDepth = 1
  97.     InitialFolder = CurDir
  98.     DirStructure = "{"
  99.     DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(-1)) & "}" + newLine
  100.     Screen.MousePointer = ccHourglass
  101.     ScanFolders
  102.     DirStructure = DirStructure & "}"
  103.     RichTextBox1.TextRTF = DirStructure
  104.     Screen.MousePointer = ccDefault
  105. End Sub
  106. Sub ScanFolders()
  107. Dim subFolders As Integer
  108. Dim txtLine As String
  109.     txtLine = ""
  110.     For j = 0 To File1.ListCount - 1
  111.         txtLine = txtLine & Space(currentDepth * 5) + File1.List(j) & newLine
  112.     Next
  113.     DirStructure = DirStructure & txtLine
  114.     subFolders = Dir2.ListCount
  115.     If subFolders > 0 Then
  116.         currentDepth = currentDepth + 1
  117.         For i = 0 To subFolders - 1
  118. 'msgbox "moving from " & CurDir & " to " & Dir1.List(i)
  119.             DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(i)) & "}" & newLine
  120.             File1.Path = Dir2.List(i)
  121.             ChDir CurDir    'Dir2.List(i)
  122.             Dir2.Path = Dir2.List(i)
  123.             ScanFolders
  124.         Next
  125.         currentDepth = currentDepth - 1
  126.         DoEvents
  127.     End If
  128.     MoveUp
  129.     File1.Path = Dir2.Path
  130. End Sub
  131. Sub MoveUp()
  132.     If Dir2.List(-1) <> InitialFolder Then
  133.         ChDir Dir2.List(-2)
  134.         Dir2.Path = Dir2.List(-2)
  135.     End If
  136. End Sub
  137. Private Sub Command2_Click()
  138.     CommonDialog1.Action = 1
  139.     If CommonDialog1.filename = "" Then Exit Sub
  140.     Text1.Text = CommonDialog1.filename
  141. End Sub
  142. Private Sub Dir1_Change()
  143.     ChDir Dir1.Path
  144.     Dir2.Path = Dir1.Path
  145.     File1.Path = Dir2.Path
  146. End Sub
  147. Private Sub Drive1_Change()
  148.     ChDrive Drive1.Drive
  149.     Dir1.Path = Drive1.Drive
  150.     Dir2.Path = Drive1.Drive
  151. End Sub
  152. Private Sub Form_Load()
  153.     ChDrive App.Path
  154.     ChDir App.Path
  155. End Sub
  156. Private Sub Form_Resize()
  157.     RichTextBox1.Height = Form1.Height - RichTextBox1.Top - 525
  158. End Sub
  159.