home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD171223162001.psc / FileFinder.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-27  |  4.4 KB  |  133 lines

  1. Attribute VB_Name = "FileFinder"
  2. Option Explicit
  3. Option Compare Text
  4. Option Base 0
  5. ' This module contains procedures to help with file finding.
  6. ' Ideally should be bundled with FrmFindFiles, though you may find that you can use
  7. ' the code in this module seperately (you'll have to remove the function FileFindDialog)
  8.  
  9. ' Recursively searches a directory tree trying to match files using a regular expression
  10. ' such as *.txt (or combinations thereof, e.g. "*.cls;*.bas")
  11. ' Any files that match are placed into a collection of strings.
  12.  
  13. ' You will not be able to use the For Each method on this collection, (without a bit of kludging anyway).
  14. ' instead use:
  15. ' for i = 1 to collection.count
  16. '      ...
  17. ' next
  18. '
  19. ' If anyone wants, I'll turn this into an Event-driven class or User-control.
  20.  
  21. Private Const MaxRecursionDepth As Long = 512
  22.  
  23. Private FileColl As Collection
  24. Public ffRunning As Boolean
  25. Public ffStopping As Boolean
  26.  
  27. Public Function FileFindDialog(ByRef pCollection As Collection, Optional pStartPath As String = "")
  28.     frmFindFiles.FindFilesForm pCollection, pStartPath
  29. End Function
  30.  
  31. Public Function FindFiles(Path As String, RegExp As String, _
  32.         Optional RecurseSubFolders As Boolean = True, _
  33.         Optional OlderThan As Date, _
  34.         Optional ProgressLabel As Label = Nothing) As Collection
  35. Dim X As String
  36. Dim i As Long
  37.  
  38.     If OlderThan = Empty Then
  39.       OlderThan = Now
  40.     End If
  41.     If ffRunning = True Then
  42.         Set FindFiles = Nothing
  43.         Exit Function
  44.     End If
  45.     ffRunning = True
  46.     ffStopping = False
  47.    Set FileColl = New Collection
  48.    DirectoryWalk Path, RegExp, 1, RecurseSubFolders, OlderThan, ProgressLabel
  49.    Set FindFiles = FileColl
  50.    If ffStopping = True Then
  51.     Set FindFiles = Nothing
  52.    End If
  53.    ffRunning = False
  54.    ffStopping = False
  55. End Function
  56.  
  57. Public Function StopFindFiles()
  58.     If ffRunning = True Then
  59.         ffStopping = True
  60.     End If
  61. End Function
  62.  
  63. Private Sub DirectoryWalk(ByVal Path As String, ByVal RegularExpression As String, ByVal CurrentDepth As Long, _
  64.         Optional ByVal RecurseSubFolders As Boolean = True, _
  65.         Optional ByVal OlderThan As Date, _
  66.         Optional ProgressLabel As Label = Nothing)
  67. Dim PrivCollection As Collection
  68. Dim File As String
  69. Dim RegExp(10) As String
  70. Dim Regularexpressions As Long
  71. Dim i As Long
  72. Dim Recurse As String
  73.  
  74.     If CurrentDepth > MaxRecursionDepth Then
  75.       Exit Sub
  76.     End If
  77.     If Not (ProgressLabel Is Nothing) Then
  78.         ProgressLabel.Caption = "Processing: " & Path
  79.     End If
  80.     DoEvents
  81.     ' Read in regular expressions
  82.     Regularexpressions = 0
  83.     SplitStringIntoParts RegularExpression, ";"
  84.     Do While Regularexpressions <= 10
  85.         RegExp(Regularexpressions) = GetNextPartOfSplitString
  86.         If Len(RegExp(Regularexpressions)) = 0 Then
  87.             If Regularexpressions > 0 Then
  88.                 Regularexpressions = Regularexpressions - 1
  89.                 Exit Do
  90.             End If
  91.         End If
  92.         Regularexpressions = Regularexpressions + 1
  93.     Loop
  94.  
  95.     Set PrivCollection = New Collection
  96.     ' Read in entries into directory
  97.     If Right(Path, 1) <> "\" Then
  98.         Path = Path & "\"
  99.     End If
  100.     File = Dir(Path & "*.*", vbDirectory)
  101.     Do While File <> ""
  102.         If File <> "." And File <> ".." Then
  103.             If (GetAttr(Path & File) And vbDirectory) = vbDirectory Then
  104.                 PrivCollection.Add Path & File
  105.             Else
  106.                 For i = 0 To Regularexpressions
  107.                     If File Like RegExp(i) Then
  108.                       If DateDiff("s", OlderThan, FileDateTime(Path & File)) < 0 Then
  109.                         FileColl.Add Path & File
  110.                         If Not (ProgressLabel Is Nothing) Then
  111.                             ProgressLabel.Caption = "Found: " & Path & File
  112.                         End If
  113.                         DoEvents
  114.                       End If
  115.                     End If
  116.                 Next
  117.             End If
  118.         End If
  119.         File = Dir
  120.     Loop
  121.     DoEvents
  122.     ' Recursion
  123.     If RecurseSubFolders = True And ffStopping = False Then
  124.         For i = 1 To PrivCollection.Count
  125.             Recurse = PrivCollection(i)
  126.             Call DirectoryWalk(Recurse, RegularExpression, CurrentDepth + 1, RecurseSubFolders, OlderThan, ProgressLabel)
  127.             If ffStopping = True Then
  128.                 Exit For
  129.             End If
  130.         Next
  131.     End If
  132. End Sub
  133.