获取一个目录下的文件结构

环境：VB6

控件：一个List，一个TextBox，一个Label

代码：

Dim wpath As String
Dim cnt As Integer
Const SEP = "\"

Public Function GetExtName(strFileName As String) As String
Dim strTmp As String
Dim strByte As String
Dim i As Long
  For i = Len(strFileName) To 1 Step -1
     strByte = Mid(strFileName, i, 1)
     If strByte <> "." Then
        strTmp = strByte + strTmp
    Else
      Exit For
    End If
  Next i
  GetExtName = strTmp
End Function

Public Function search(ByVal strPath As String, Optional strSearch As String = "") As Boolean
Dim strFileDir() As String
Dim strFile As String
Dim i As Long
Dim subpath As String

Dim lDirCount As Long
On Error GoTo MyErr
  If Right(strPath, 1) <> SEP Then strPath = strPath + SEP

    strFile = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
    While strFile <> ""
        DoEvents
        If (GetAttr(strPath + strFile) And vbDirectory) = vbDirectory Then
           If strFile <> "." And strFile <> ".." Then
                cnt = cnt + 1
                lDirCount = lDirCount + 1
                ReDim Preserve strFileDir(lDirCount) As String
                strFileDir(lDirCount - 1) = strFile

           End If
        Else
            If strSearch = "" Then
                subpath = Replace(strPath + strFile, wpath, "")
                cnt = cntstring(subpath, SEP)
                Debug.Print String(cnt, vbTab) & "" & strFile
                Form1.List1.AddItem strPath + strFile
            ElseIf LCase(GetExtName(strPath + strFile)) = LCase(GetExtName(strSearch)) Then
               Form1.List1.AddItem strPath + strFile
            End If
        End If
        strFile = Dir
    Wend

    For i = 0 To lDirCount - 1
        Form1.Label3.Caption = strPath + strFileDir(i)

        subpath = Replace(strPath + strFileDir(i), wpath, "")
        cnt = cntstring(subpath, SEP)

        Debug.Print String(cnt, vbTab) & "." & SEP & strFileDir(i)
        Debug.Print ""
        Call search(strPath + strFileDir(i), strSearch)
    Next

    ReDim strFileDir(0)
    search = True
Exit Function

MyErr:
  search = False
End Function

Private Sub Command1_Click()
    wpath = Trim(Text1)
    If Right(wpath, 1) <> SEP Then wpath = wpath + SEP
    search wpath
End Sub

Private Function cntstring(s As String, p As String) As Integer
Dim i As Integer
Dim c As Integer
    For i = 1 To Len(s)
        If Mid(s, i, 1) = p Then
            c = c + 1
        End If
    Next
    cntstring = c
End Function

使用时，在TextBox中填入目录完整路径，点击按钮
然后在VB的立即窗口中就生成文件结构了。

变量命名规则请忽略。