Private Sub Command1_Click() sDirTraversal "c:\windows",List1 End Sub Private Sub Command2_Click() Dim sE As Long,cP As Long,tP As String,tplt As Integer tP = UCase(InputBox("Type:=")): tplt = Len(tP) For sE = 0 To List1.ListCount - 1 If UCase(Right(List1.List(sE),tplt)) = tP Then List2.AddItem List1.List(sE) Next List1.Clear For cP = 0 To List2.ListCount - 1 List1.AddItem List2.List(cP) Next List2.Clear End Sub Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String,lpFindFileData As WIN32_FIND_DATA) As Long Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long,lpFindFileData As WIN32_FIND_DATA) As Long Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long '最大路径长度和文件属性常量的定义 Public Const MAX_PATH = 260 Public Const FILE_ATTRIBUTE_ARCHIVE = &H20 Public Const FILE_ATTRIBUTE_COMpressed = &H800 Public Const FILE_ATTRIBUTE_DIRECTORY = &H10 Public Const FILE_ATTRIBUTE_HIDDEN = &H2 Public Const FILE_ATTRIBUTE_norMAL = &H80 Public Const FILE_ATTRIBUTE_READONLY = &H1 Public Const FILE_ATTRIBUTE_SYstem = &H4 Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 '自定义数据类型FILETIME和WIN32_FIND_DATA的定义 Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccesstime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Public Function fDelInvaildChr(str As String) As String On Error Resume Next For i = Len(str) To 1 Step -1 If Asc(Mid(str,i,1)) <> 0 And Asc(Mid(str,1)) <> 32 Then fDelInvaildChr = Left(str,i) Exit For End If Next End Function '遍历主函数 '参数说明: ' strPathName 要遍历的目录 ' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以 ' 不使用字符串数组是因为数组大小不好定义 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub sDirTraversal(ByVal strPathName As String,ByRef objList As ListBox) Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整 Dim iIndex As Integer '子目录数组下标 Dim i As Integer '用于循环子目录的查找 Dim lHandle As Long 'FindFirstFileA 的句柄 Dim tFindData As WIN32_FIND_DATA ' Dim strFileName As String '文件名 On Error Resume Next '初始化变量 i = 1 iIndex = 0 tFindData.cFileName = "" '初始化定长字符串 lHandle = FindFirstFile(strPathName & "\*.*",tFindData) '扩展名 If lHandle = 0 Then '查询结束或发生错误 Exit Sub End If strFileName = fDelInvaildChr(tFindData.cFileName) If tFindData.dwFileAttributes = &H10 Then '目录 If strFileName <> "." And strFileName <> ".." Then iIndex = iIndex + 1 sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组 End If Else objList.AddItem strPathName & "\" & strFileName End If '循环查找下一个文件,直到结束 do while True tFindData.cFileName = "" If FindNextFile(lHandle,tFindData) = 0 Then '查询结束或发生错误 FindClose (lHandle) Exit Do Else strFileName = fDelInvaildChr(tFindData.cFileName) If tFindData.dwFileAttributes = &H10 Then If strFileName <> "." And strFileName <> ".." Then iIndex = iIndex + 1 sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组 End If Else objList.AddItem strPathName & "\" & strFileName End If End If Loop '如果该目录下有目录,则根据目录数组递归遍历 If iIndex > 0 Then For i = 1 To iIndex sDirTraversal sSubDir(i),objList Next End If End Sub Private Sub Form_Click() On Error Resume Next Dim sFile As String sFile = Dir("C:\") do while Len(sFile) List1.AddItem sFile sFile = Dir() Loop End Sub
原文地址:https://www.jb51.cc/vb/259284.html
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。