VB遍历目录文件
2012-12-26 15:33
141 查看
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, i, 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
相关文章推荐
- VB 中遍历目录,遍历目录查找文件的2个实现方法
- VB 中遍历目录,遍历目录查找文件的2个实现方法(挺好)
- VB用API函数遍历指定驱动器、目录的文件
- VB.NET遍历目录和文件
- VB遍历某目录下的某类型文件(Dir)
- vb.net 使用 DIR 遍历文件目录
- Python:遍历一个目录下所有的文件及文件夹,然后计算每个文件的字符和line的小程序
- ASP,FSO遍历目录及目录下文件
- c++遍历创建文件目录
- C/C++遍历目录下的文件或指定文件
- 遍历制定目录下的txt文件,并打印文件里匹配的字符串
- web developer tips (26):在 App_Code目录下同时放c#和VB.NET文件
- python指定文件目录遍历方法
- php遍历删除整个目录及文件的方法
- PHP遍历文件目录与清除目录中的文件
- php递归遍历所有目录及子目录和文件实例
- 遍历目录下的文件
- 遍历目录下的所有文件-os.walk
- linux下遍历目录和文件,删除过期天数目录或文件shell脚本
- 遍历一个文件目录下的所有文件