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

最新推荐文章于 2021-07-21 20:44:59 发布

小鸿叔

最新推荐文章于 2021-07-21 20:44:59 发布

阅读量3.4k

点赞数

分类专栏： VB 文章标签： vb string function integer command

本文链接：https://blog.csdn.net/jyh_jack/article/details/2065433

版权

VB 专栏收录该内容

77 篇文章 8 订阅

订阅专栏

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