VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "FileFinder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' add the Microsoft Scripting Runtime reference to the environemnt
Private fso As Scripting.FileSystemObject
Private databasePath As String
Private root As Drive
Private dbString As String
Private driveLetter As String
Private Sub Class_Initialize()
    databasePath = "C:\fdb.txt"
    dbString = ""
End Sub
Public Sub SetDatabase(dbPath As String, dLetter As String)
    databasePath = dbPath
    driveLetter = dLetter
End Sub
Private Sub LoadDatabase()
    If dbString = "" Then
        Debug.Print "LoadDatabase from file " & databasePath
        Set fso = New FileSystemObject
        Set dbStream = fso.OpenTextFile(databasePath)
        dbString = dbStream.ReadAll
        Set dbStream = Nothing
        Set fso = Nothing
    End If
End Sub
' returns a collection of strings, one for each line that matched the substring
Public Function Find(substring As String) As Collection
    ' http://visualbasic.about.com/od/usingvbnet/l/blregexa.htm
    ' http://www.regular-expressions.info/vbscript.html
    Dim regex As RegExp
    Dim matches As MatchCollection
    Dim match As Object
    Dim l As String
    Dim result As Collection
    
    Debug.Print "Finding " & Chr(34) & substring & Chr(34)
    Call LoadDatabase
    
    Set result = New Collection
    
    Set regex = New RegExp
    regex.Pattern = "^(.*" & substring & ".*)$"
    regex.Global = True
    regex.MultiLine = True
    
    Debug.Print "Searching regex of " & regex.Pattern
    
    Set matches = regex.Execute(dbString)
    Debug.Print "Found " & matches.Count & " matches."
    For Each match In matches
        l = match.Value
        ' strip off trailing chars [chomp()]
        If Right(l, 1) = Chr(13) Or Right(l, 1) = Chr(10) Then
            l = Left(l, Len(l) - 1)
        End If
        If Right(l, 1) = Chr(13) Or Right(l, 1) = Chr(10) Then
            l = Left(l, Len(l) - 1)
        End If
        result.Add (l)
    Next
    Set regex = Nothing
    Set matches = Nothing
    Set Find = result
End Function
Public Sub UpdateDatabaseIfOld()
    Dim f As File
    Set fso = New FileSystemObject
    If fso.FileExists(databasePath) Then
        Set f = fso.GetFile(databasePath)
        ' http://www.aspisfun.com/functions/datetime/datediff.html
        If DateTime.DateDiff("d", f.DateLastModified, DateTime.Now) < 2 Then
            Exit Sub
        Else
            Debug.Print "Date difference between file and now is " & DateTime.DateDiff("d", f.DateLastModified, DateTime.Now)
        End If
    Else
        Debug.Print "No file at databasePath of " & databasePath
    End If
    Set fso = Nothing
    Call UpdateDatabase ' gets here if it's old or nonexistent
End Sub
' usually, you should call UpdateDatabaseIfOld
Public Sub UpdateDatabase()
    Dim dbStream As TextStream
    Set fso = New FileSystemObject
    If fso.FileExists(databasePath) Then
        fso.DeleteFile (databasePath)
    End If
    Set dbStream = fso.CreateTextFile(databasePath)
    Debug.Print ("scanning drive lettter " & driveLetter)
    Set root = fso.Drives(driveLetter)
    Call UpdateDatabaseRecurse(root.RootFolder, "\", dbStream)
    Call dbStream.Close
    Set dbStream = Nothing
    Set fso = Nothing
End Sub
Private Sub UpdateDatabaseRecurse(f As Folder, path As String, dbStream As TextStream)
    Dim subf As Folder
    Dim obj As File
    Dim ln As String
    For Each subf In f.SubFolders
        ' Debug.Print "folder " & root.driveLetter & ":" & path & subf.Name
        On Error Resume Next
            Call UpdateDatabaseRecurse(subf, path & subf.Name & "\", dbStream)
    Next
    For Each obj In f.Files
        ln = root.driveLetter & ":" & path & obj.Name
        ' Debug.Print "file " & ln
        dbStream.WriteLine (ln)
    Next
    Set subf = Nothing
    Set obj = Nothing
End Sub