环境: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的立即窗口中就生成文件结构了。
变量命名规则请忽略。