学步园

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