Function FindDirectory(RootPath As
String, Mydirectory() As String)
Dim intResult, I, intFind As Integer
‘首先查找根目录下的所有子目录
MyPath = "c:\" 注释: 指定路径c:\。
MyName = Dir(MyPath, vbDirectory) 注释: 找寻第一项。
intResult = 1
ReDim Mydirectory(intResult) ‘初始化动态数组
Do While MyName < > "" 注释: 开始循环。
注释: 跳过当前的目录及上层目录。
If MyName < > "." And MyName < > ".." Then
注释: 使用位比较来确定 MyName 代表一目录。
If (GetAttr(MyPath & MyName)
And vbDirectory) = vbDirectory Then
注释: 如果它是一个目录,将其名称存储在一个数组里。
Mydirectory(intResult) = MyPath & MyName
intResult = intResult + 1
ReDim Preserve Mydirectory(intResult)
‘分配动态数组实际的元素个数,并保留数组中的数据
End If
End If
MyName = Dir 注释: 查找下一个目录。
Loop
‘在所有目录里分别查找文件是否存在。
For I = 1 To UBound(Mydirectory)-1
MyFile = Mydirectory(I) & "\win.ini"
intFind = Len(Dir(MyFile))
If intFind < > 0 Then MsgBox "找到文件" &
Dir(MyFile) & "在:" & Mydirectory(I)
Next I
End Function
Declare
Public Declare Function SearchTreeForFile Lib
"imagehlp.dll" (ByVal lpRoothPath As String,
ByVal lpInputName As String,
ByVal lpOutputName As String) As Long
---- 下面为sysFileFind函数的编码:
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
Public Sub scan(a As String)
Dim filename As String
Dim nd As Integer
Dim fold() As String
Dim n As Integer
filename = Dir(a)
Do While filename <> “”
If Option1.Value =True Then
If LCase(filename) = LCase(Text1.Text) Then
List1.AddItem (a & filename)
End If
Else
If LCase(Right(filename, 3)) = LCase(Text2.Text) Then
List1.AddItem (a & filename)
End If
End If
filename = Dir
Loop
filename = Dir(a, vbDirectory)
Do While filename <> “”
If filename <>“.” And filename <> “..” Then
If GetAttr(a & filename) = vbDirectory Then
nd = nd + 1
ReDim Preserve fold(nd)
fold(nd) = a & filename
End If
End If
filename = Dir
DoEvents
Loop
For n = 1 To nd
scan fold(n) & “\”
Next
If List1.ListCount = 0 Then
StatusBar1.SimpleText = “No file discovery”
Else
StatusBar1.SimpleText = List1.ListCount & “file(s) discovery”
End If
End Sub
Private Sub Command1_Click()
Dim searchfold As String
List1.Clear
StatusBar1.SimpleText = “”
If Right(Dir1.Path, 1) = “\” Then
searchfold = Left(Dir1.Path, 2)
Else
searchfold = Dir1.Path
End If
Me.MousePointer = vbHourglass
scan searchfold & “\”
Me.MousePointer = vbDefault
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Drive1_Change()
On Error GoTo a
Dir1.Path = Drive1.Drive
Exit Sub
a:
If Left(Drive1.Drive, 1) = “a” Then
MsgBox “Floppy drive is not be ready!”, vbCritical
End If
End Sub
Private Sub Option1_Click()
Text1.Enabled = True
Text2.Enabled = False
End Sub
Private Sub Option2_Click()
Text1.Enabled = False
Text2.Enabled = True
End Sub