Advertisement
2_2002-2004 Files/ File Controls/ Input/ Output #117639

FindFile - Fast, using the API

Uses the FindFile, FindNextFile, and SearchPath API functions to quickly find a file on your hard drive. Runs faster than methods which use Dir$.

AI

Shrnutí AI: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Zdrojový kód
original-source
Public Function FindFile(ByVal FileName As String, ByVal Path As String) As String
Dim hFile As Long, ts As String, WFD As WIN32_FIND_DATA
Dim result As Long, sAttempt As String, szPath As String
szPath = GetRDP(Path) & "*.*" & Chr$(0)
'Note: Inline function here
'----Starts----
Dim szPath2 As String, szFilename As String, dwBufferLen As Long, szBuffer As String, lpFilePart As String
'Set variables
szPath2 = Path & Chr$(0)
szFilename = FileName & Chr$(0)
szBuffer = String$(MAX_PATH, 0)
dwBufferLen = Len(szBuffer)
'Ask windows if it can find a file matching the filename you gave it.
result = SearchPath(szPath2, szFilename, vbNullString, dwBufferLen, szBuffer, lpFilePart)
'----Ends----
If result Then
  FindFile = StripNull(szBuffer)
  Exit Function
End If
'Start asking windows for files.
hFile = FindFirstFile(szPath, WFD)
Do
  
  If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
    'Hey look, we've got a directory!
    ts = StripNull(WFD.cFileName)
    
    If Not (ts = "." Or ts = "..") Then
      
      'Don't look for hidden or system directories
      If Not (WFD.dwFileAttributes And (FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM)) Then
          
        'Search directory recursively
        sAttempt = FindFile(FileName, GetRDP(Path) & ts)
        If sAttempt <> "" Then
          FindFile = sAttempt
          Exit Do
        End If
        
      End If
    
    End If
  End If
  WFD.cFileName = ""
  result = FindNextFile(hFile, WFD)
Loop Until result = 0
FindClose hFile
End Function
Public Function StripNull(ByVal WhatStr As String) As String
  Dim pos As Integer
  pos = InStr(WhatStr, Chr$(0))
  If pos > 0 Then
    StripNull = Left$(WhatStr, pos - 1)
  Else
    StripNull = WhatStr
  End If
End Function
Public Function GetRDP(ByVal sPath As String) As String
'Adds a backslash on the end of a path, if required.
  If sPath = "" Then Exit Function
  If Right$(sPath, 1) = "\" Then GetRDP = sPath: Exit Function
  GetRDP = sPath & "\"
End Function

Upload
Původní komentáře (3)
Obnoveno z Wayback Machine