用VB函数Dir实现递归搜索目录

核心提示：用VB函数Dir实现递归搜索目录我在很久以前就实现了这个方法了.它没有采用任何的控件形式.也没有调用系统API函数FindFirst,FindNext进行递归调用,和别人有点不同的就是我用的是VB中的Dir()函数.事实上,直接采用Dir()函数是不能进行自身的递归的调用的,但我们可以采用一种办法把Dir将当前搜索目录

用VB函数Dir实现递归搜索目录

我在很久以前就实现了这个方法了.它没有采用任何的控件形式.也没有调用系统API函数FindFirst,FindNext进行递归调用,和别人有点不同的就是我用的是VB中的Dir()函数.事实上,直接采用Dir()函数是不能进行自身的递归的调用的,但我们可以采用一种办法把Dir将当前搜索目录的子目录给保存下来,然后在自身的search(strPathName)递归函数中依次进行递归的调用,这样就可以把指定的目录搜索完毕.

具体代码如下:

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'函数GetExtName

'功能:得到文件后缀名(扩展名)

'输入:文件名

'输出:文件后缀名(扩展名)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

PublicFunctionGetExtName(strFileNameAsString)AsString
DimstrTmpAsString
DimstrByteAsString
DimiAsLong
Fori=Len(strFileName)To1Step-1
strByte=Mid(strFileName,i,1)
IfstrByte<>"."Then
strTmp=strByte strTmp
Else
ExitFor
EndIf
Nexti
GetExtName=strTmp
EndFunction
PublicFunctionsearch(ByValstrPathAsString,OptionalstrSearchAsString="")AsBoolean
DimstrFileDir()AsString
DimstrFileAsString
DimiAsLong

DimlDirCountAsLong
OnErrorGoToMyErr
IfRight(strPath,1)<>"\"ThenstrPath=strPath "\"
strFile=Dir(strPath,vbDirectoryOrvbHiddenOrvbNormalOrvbReadOnly)
WhilestrFile<>""'搜索当前目录
DoEvents
If(GetAttr(strPath strFile)AndvbDirectory)=vbDirectoryThen'如果找到的是目录
IfstrFile<>"."AndstrFile<>".."Then'排除掉父目录(..)和当前目录(.)
lDirCount=lDirCount 1'将目录数增1
ReDimPReservestrFileDir(lDirCount)AsString
strFileDir(lDirCount-1)=strFile'用动态数组保存当前目录名
EndIf
Else
IfstrSearch=""Then
Form1.List1.AddItemstrPath strFile
ElseIfLCase(GetExtName(strPath strFile))=LCase(GetExtName(strSearch))Then
'满足搜索条件，则处理该文件
Form1.List1.AddItemstrPath strFile'将文件全名保存至列表框List1中
EndIf
EndIf
strFile=Dir
Wend
Fori=0TolDirCount-1
Form1.Label3.Caption=strPath strFileDir(i)
Callsearch(strPath strFileDir(i),strSearch)'递归搜索子目录
Next
ReDimstrFileDir(0)'将动态数组清空
search=True'搜索成功
ExitFunction
MyErr:
search=False'搜索失败
EndFunction

->