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
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