VB查找硬盘文件（全硬搜索）

Private Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal lpRoothPath As String, ByVal lpInputName As String, ByVal lpOutputName As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Function getDirList() As String() '得到硬盘列表，下标0开始

Dim tmp As String * 64
GetLogicalDriveStrings Len(tmp), tmp '得到所有外存盘符列表

dirlist = Split(tmp, Chr(0))
Dim Count As Integer
Count = 0
Dim arr() As String
For i = 0 To UBound(dirlist)
  Select Case GetDriveType(dirlist(i))
    Case 2 'Removable
    Case 3 'Drive Fixed
        ReDim Preserve arr(Count) As String
        arr(Count) = dirlist(i)
        Count = Count + 1
    Case 4 'Remote
    Case 5 'CD-ROM
    Case 6 'RAM Disk
    Case Else 'Unrecognized
  End Select
Next
getDirList = arr
End Function

Public Function sysFileFind(ByVal WhichRootPath As String, ByVal WhichFileName As String) As String
Dim iNull As Integer
Dim lResult As Long
Dim sBuffer As String

On Error GoTo L_FILEFINDERROR
sBuffer = String$(1024, 0)
'注释:查找文件

lResult = SearchTreeForFile(WhichRootPath, WhichFileName, sBuffer)
'注释：如果文件找到，将返回字符串后续的空格删除
'注释:否则返回一个空字符串
If lResult Then
    iNull = InStr(sBuffer, vbNullChar)
    If Not iNull Then
        sBuffer = Left$(sBuffer, iNull - 1)
    End If
    sysFileFind = sBuffer
    Else
        sysFileFind = ""
End If
Exit Function
L_FILEFINDERROR:
  MsgBox "查找文件过程中遇到错误！", vbInformation, "查找文件错误", sysFileFind = Format(Err.Number) & " - " & Err.Description

End Function

Function allSearch(FileName As String) As String
  arr = getDirList() '得到硬盘列表
  allSearch = ""
  For i = 0 To UBound(arr)
    allSearch = sysFileFind(arr(i), FileName)
    If Len(allSearch) > 0 Then
      Exit For
    End If
  Next
End Function

Private Sub Command1_Click()
Print allSearch("PS7.reg") '查找文件PS7.reg
End Sub