Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias _
      "FindFirstFileA" (ByVal lpFileName As String, _
      lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias _
      "FindNextFileA" (ByVal hFindFile As Long, _
      lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal _
      hFindFile As Long) As Long

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Private m_lngDirCount As Long
Private m_lngFileCount As Long
Private m_astrFiles() As String

Private m_blnCancel As Boolean

Private Sub Form_Load()
  lblMsg.Caption = ""
  lstFiles.Clear
End Sub

Private Sub cmdSuchen_Click()
  Dim tStart As Single
  Dim tEnd As Single
  Dim tDiff As String

  Dim i As Long
  Dim strMsg As String

  lstFiles.Visible = False
  lstFiles.Clear

  m_blnCancel = False
  m_lngDirCount = 1
  m_lngFileCount = 0

  ReDim m_astrFiles(0 To 100)

  tStart = GetTickCount()
  FindFiles Dir1.Path, txtSearchString.Text

  If m_lngFileCount > 0 Then
    lblMsg.Caption = "Bitte warten... " & _
          "Die Dateien werden zur ListBox hinzugefügt..."
    DoEvents
    For i = 0 To m_lngFileCount - 1
      lstFiles.AddItem m_astrFiles(i)
    Next
  End If

  tEnd = GetTickCount()
  tDiff = Format$((tEnd - tStart) / 1000, "##0.00") & "  sec."

  strMsg = m_lngFileCount & " Dateien gefunden / " & _
           m_lngDirCount & " Ordner durchsucht."

  If m_blnCancel Then
    lblMsg.Caption = _
        "Die Suche nach Datei(en) wurde abgebrochen!  " & strMsg
  Else
    lblMsg.Caption = strMsg & " (Dauer: " & tDiff & ")"
  End If

  lstFiles.Visible = True
End Sub

Private Sub cmdAbbrechen_Click()
  m_blnCancel = True
End Sub

Private Sub FindFiles(ByVal vsFolderPath As String, _
      ByVal vsSearch As String)

  Dim WFD As WIN32_FIND_DATA
  Dim hSearch As Long
  Dim strDirName As String

  If m_blnCancel = True Then GoTo byebye

  lblMsg.Caption = vsFolderPath
  DoEvents

  If Right$(vsFolderPath, 1) <> "\" Then
    vsFolderPath = vsFolderPath & "\"
  End If

  hSearch = FindFirstFile(vsFolderPath & "*.*", WFD)

  If hSearch <> INVALID_HANDLE_VALUE Then
    GetFilesInFolder vsFolderPath, vsSearch

    Do
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
        strDirName = TrimNulls(WFD.cFileName)
        If (strDirName <> ".") And (strDirName <> "..") Then
          m_lngDirCount = m_lngDirCount + 1
          FindFiles vsFolderPath & strDirName, vsSearch
        End If
      End If
    Loop While FindNextFile(hSearch, WFD)
    FindClose hSearch
  End If
byebye:
End Sub

Private Sub GetFilesInFolder(ByVal vsFolderPath As String, _
        ByVal vsSearch As String)
  Dim WFD As WIN32_FIND_DATA
  Dim hSearch As Long
  Dim strFileName As String

  If Right$(vsFolderPath, 1) <> "\" Then
    vsFolderPath = vsFolderPath & "\"
  End If

  hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
  If hSearch <> INVALID_HANDLE_VALUE Then
    Do
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> _
                    FILE_ATTRIBUTE_DIRECTORY Then
        strFileName = TrimNulls(WFD.cFileName)
        m_astrFiles(m_lngFileCount) = vsFolderPath & strFileName
        m_lngFileCount = m_lngFileCount + 1

        If (m_lngFileCount Mod 100) = 0 Then
          ReDim Preserve m_astrFiles(m_lngFileCount + 100)
        End If
      End If
    Loop While FindNextFile(hSearch, WFD)
    FindClose hSearch
  End If
End Sub

Private Function TrimNulls(ByVal vsStringIn As String) As String
  If InStr(vsStringIn, Chr(0)) > 0 Then
    vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) - 1)
  End If
  TrimNulls = vsStringIn
End Function