home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / vbgui10 / seek.frm (.txt) < prev   
Encoding:
Visual Basic Form  |  1998-01-26  |  9.7 KB  |  275 lines
  1. VERSION 5.00
  2. Begin VB.Form WinSeek 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "File Search "
  6.    ClientHeight    =   4905
  7.    ClientLeft      =   2685
  8.    ClientTop       =   1725
  9.    ClientWidth     =   4185
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H00000080&
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   4905
  23.    ScaleWidth      =   4185
  24.    Begin VB.PictureBox Picture2 
  25.       BorderStyle     =   0  'None
  26.       Height          =   3975
  27.       Left            =   4320
  28.       ScaleHeight     =   3975
  29.       ScaleWidth      =   2055
  30.       TabIndex        =   8
  31.       Top             =   0
  32.       Visible         =   0   'False
  33.       Width           =   2055
  34.       Begin VB.ListBox lstFoundFiles 
  35.          Height          =   3375
  36.          Left            =   -120
  37.          TabIndex        =   11
  38.          Top             =   480
  39.          Width           =   4335
  40.       End
  41.       Begin VB.Label lblCount 
  42.          Caption         =   "0"
  43.          Height          =   255
  44.          Left            =   3360
  45.          TabIndex        =   10
  46.          Top             =   120
  47.          Width           =   1575
  48.       End
  49.       Begin VB.Label lblfound 
  50.          Caption         =   "&Files Found:"
  51.          Height          =   255
  52.          Left            =   120
  53.          TabIndex        =   9
  54.          Top             =   120
  55.          Width           =   3135
  56.       End
  57.    End
  58.    Begin VB.PictureBox Picture1 
  59.       BorderStyle     =   0  'None
  60.       Height          =   4215
  61.       Left            =   120
  62.       ScaleHeight     =   4215
  63.       ScaleWidth      =   6855
  64.       TabIndex        =   2
  65.       Top             =   0
  66.       Width           =   6855
  67.       Begin VB.DriveListBox drvList 
  68.          Height          =   315
  69.          Left            =   2040
  70.          TabIndex        =   7
  71.          Top             =   60
  72.          Width           =   1935
  73.       End
  74.       Begin VB.DirListBox dirList 
  75.          Height          =   3465
  76.          Left            =   2040
  77.          TabIndex        =   6
  78.          Top             =   480
  79.          Width           =   1935
  80.       End
  81.       Begin VB.FileListBox filList 
  82.          Height          =   3600
  83.          Left            =   120
  84.          TabIndex        =   5
  85.          Top             =   480
  86.          Width           =   1815
  87.       End
  88.       Begin VB.TextBox txtSearchSpec 
  89.          Height          =   315
  90.          Left            =   120
  91.          TabIndex        =   4
  92.          Text            =   "*.*"
  93.          Top             =   60
  94.          Width           =   1815
  95.       End
  96.       Begin VB.Label lblCriteria 
  97.          Caption         =   "Search &Criteria:"
  98.          Height          =   255
  99.          Left            =   600
  100.          TabIndex        =   3
  101.          Top             =   120
  102.          Width           =   1335
  103.       End
  104.    End
  105.    Begin VB.CommandButton cmdSearch 
  106.       BackColor       =   &H00C0C0C0&
  107.       Caption         =   "&Search"
  108.       Default         =   -1  'True
  109.       Height          =   480
  110.       Left            =   480
  111.       TabIndex        =   0
  112.       Top             =   4320
  113.       Width           =   1200
  114.    End
  115.    Begin VB.CommandButton cmdExit 
  116.       BackColor       =   &H00C0C0C0&
  117.       Caption         =   "E&xit"
  118.       Height          =   480
  119.       Left            =   2520
  120.       TabIndex        =   1
  121.       Top             =   4320
  122.       Width           =   1200
  123.    End
  124. Attribute VB_Name = "WinSeek"
  125. Attribute VB_GlobalNameSpace = False
  126. Attribute VB_Creatable = False
  127. Attribute VB_PredeclaredId = True
  128. Attribute VB_Exposed = False
  129. Option Explicit
  130. Dim SearchFlag As Integer   ' Used as flag for cancel and other operations.
  131. Private Sub cmdExit_Click()
  132.     If cmdExit.Caption = "E&xit" Then
  133.         Unload Me
  134.     Else                    ' If user chose Cancel, just end Search.
  135.         SearchFlag = False
  136.     End If
  137. End Sub
  138. Private Sub cmdSearch_Click()
  139. ' Initialize for search, then perform recursive search.
  140. Dim FirstPath As String, DirCount As Integer, NumFiles As Integer
  141. Dim result As Integer
  142.   ' Check what the user did last.
  143.     If cmdSearch.Caption = "&Reset" Then  ' If just a reset, initialize and exit.
  144.         ResetSearch
  145.         txtSearchSpec.SetFocus
  146.         Exit Sub
  147.     End If
  148.     ' Update dirList.Path if it is different from the currently
  149.     ' selected directory, otherwise perform the search.
  150.     If dirList.Path <> dirList.List(dirList.ListIndex) Then
  151.         dirList.Path = dirList.List(dirList.ListIndex)
  152.         Exit Sub         ' Exit so user can take a look before searching.
  153.     End If
  154.     ' Continue with the search.
  155.     Picture2.Move 0, 0
  156.     Picture1.Visible = False
  157.     Picture2.Visible = True
  158.     cmdExit.Caption = "Cancel"
  159.     filList.Pattern = txtSearchSpec.Text
  160.     FirstPath = dirList.Path
  161.     DirCount = dirList.ListCount
  162.     ' Start recursive direcory search.
  163.     NumFiles = 0                       ' Reset found files indicator.
  164.     result = DirDiver(FirstPath, DirCount, "")
  165.     filList.Path = dirList.Path
  166.     cmdSearch.Caption = "&Reset"
  167.     cmdSearch.SetFocus
  168.     cmdExit.Caption = "E&xit"
  169. End Sub
  170. Private Function DirDiver(NewPath As String, DirCount As Integer, BackUp As String) As Integer
  171. '  Recursively search directories from NewPath down...
  172. '  NewPath is searched on this recursion.
  173. '  BackUp is origin of this recursion.
  174. '  DirCount is number of subdirectories in this directory.
  175. Static FirstErr As Integer
  176. Dim DirsToPeek As Integer, AbandonSearch As Integer, ind As Integer
  177. Dim OldPath As String, ThePath As String, entry As String
  178. Dim retval As Integer
  179.     SearchFlag = True           ' Set flag so the user can interrupt.
  180.     DirDiver = False            ' Set to True if there is an error.
  181.     retval = DoEvents()         ' Check for events (for instance, if the user chooses Cancel).
  182.     If SearchFlag = False Then
  183.         DirDiver = True
  184.         Exit Function
  185.     End If
  186.     On Local Error GoTo DirDriverHandler
  187.     DirsToPeek = dirList.ListCount                  ' How many directories below this?
  188.     Do While DirsToPeek > 0 And SearchFlag = True
  189.         OldPath = dirList.Path                      ' Save old path for next recursion.
  190.         dirList.Path = NewPath
  191.         If dirList.ListCount > 0 Then
  192.             ' Get to the node bottom.
  193.             dirList.Path = dirList.List(DirsToPeek - 1)
  194.             AbandonSearch = DirDiver((dirList.Path), DirCount%, OldPath)
  195.         End If
  196.         ' Go up one level in directories.
  197.         DirsToPeek = DirsToPeek - 1
  198.         If AbandonSearch = True Then Exit Function
  199.     Loop
  200.     ' Call function to enumerate files.
  201.     If filList.ListCount Then
  202.         If Len(dirList.Path) <= 3 Then             ' Check for 2 bytes/character
  203.             ThePath = dirList.Path                  ' If at root level, leave as is...
  204.         Else
  205.             ThePath = dirList.Path + "\"            ' Otherwise put "\" before the filename.
  206.         End If
  207.         For ind = 0 To filList.ListCount - 1        ' Add conforming files in this directory to the list box.
  208.             entry = ThePath + filList.List(ind)
  209.             lstFoundFiles.AddItem entry
  210.             lblCount.Caption = Str(Val(lblCount.Caption) + 1)
  211.         Next ind
  212.     End If
  213.     If BackUp <> "" Then        ' If there is a superior directory, move it.
  214.         dirList.Path = BackUp
  215.     End If
  216.     Exit Function
  217. DirDriverHandler:
  218.     If Err = 7 Then             ' If Out of Memory error occurs, assume the list box just got full.
  219.         DirDiver = True         ' Create Msg and set return value AbandonSearch.
  220.         MsgBox "You've filled the list box. Abandoning search..."
  221.         Exit Function           ' Note that the exit procedure resets Err to 0.
  222.     Else                        ' Otherwise display error message and quit.
  223.         MsgBox Error
  224.         End
  225.     End If
  226. End Function
  227. Private Sub DirList_Change()
  228.     ' Update the file list box to synchronize with the directory list box.
  229.     filList.Path = dirList.Path
  230. End Sub
  231. Private Sub DirList_LostFocus()
  232.     dirList.Path = dirList.List(dirList.ListIndex)
  233. End Sub
  234. Private Sub DrvList_Change()
  235.     On Error GoTo drivehandler
  236.     dirList.Path = drvList.Drive
  237.     Exit Sub
  238. drivehandler:
  239.     drvList.Drive = dirList.Path
  240.     Exit Sub
  241. End Sub
  242. Private Sub Form_Load()
  243.     Picture2.Move 0, 0
  244.     Picture2.Width = WinSeek.ScaleWidth
  245.     Picture2.BackColor = WinSeek.BackColor
  246.     lblCount.BackColor = WinSeek.BackColor
  247.     lblCriteria.BackColor = WinSeek.BackColor
  248.     lblfound.BackColor = WinSeek.BackColor
  249.     Picture1.Move 0, 0
  250.     Picture1.Width = WinSeek.ScaleWidth
  251.     Picture1.BackColor = WinSeek.BackColor
  252. End Sub
  253. Private Sub Form_Unload(Cancel As Integer)
  254.    Unload Me
  255.    End Sub
  256. Private Sub ResetSearch()
  257.     ' Reinitialize before starting a new search.
  258.     lstFoundFiles.Clear
  259.     lblCount.Caption = 0
  260.     SearchFlag = False                  ' Flag indicating search in progress.
  261.     Picture2.Visible = False
  262.     cmdSearch.Caption = "&Search"
  263.     cmdExit.Caption = "E&xit"
  264.     Picture1.Visible = True
  265.     dirList.Path = CurDir: drvList.Drive = dirList.Path ' Reset the path.
  266. End Sub
  267. Private Sub txtSearchSpec_Change()
  268.     ' Update file list box if user changes pattern.
  269.     filList.Pattern = txtSearchSpec.Text
  270. End Sub
  271. Private Sub txtSearchSpec_GotFocus()
  272.     txtSearchSpec.SelStart = 0          ' Highlight the current entry.
  273.     txtSearchSpec.SelLength = Len(txtSearchSpec.Text)
  274. End Sub
  275.