查看: 8  |  回复: 0
  VB6 代码管家-枚举遍历文件
楼主
发表于 2024年12月8日 22:34
Private Sub Command1_Click()
    On Error Resume Next
    List1.Clear
    Dim abc As String
    Dim genmulu As String
    genmulu = "c:\"                     '路径,记得路径后面一样要加"\"
    abc = Dir(genmulu, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
    'abc = Dir(genmulu, 正常的  Or 只读的     Or 隐藏的   Or 系统文件 Or 卷标     Or 目录或文件夹Or 不知道什么怪物)
    Do While abc <> ""
        If abc <> "." And abc <> ".." Then List1.AddItem genmulu & abc
        abc = Dir                           '再次调用dir函数,此时可以不带参数
    Loop
End Sub

'==================================查看文件夹下所有的文件(包括文件夹,不包括子目录)==================================

'==================================查看文件夹下所有的文件(不包括文件夹,包括子目录)==================================
Private Function SearchFiles(Path As String, FileType As String)
        Dim Files()  As String                                      '文件路径
        Dim Folder() As String                                      '文件夹路径
        Dim a, b, c As Long
        Dim sPath As String
        If Right(Path, 1) <> "\" Then Path = Path & "\"
        sPath = Dir(Path & FileType)                                '查找第一个文件

        Do While Len(sPath)                                         '循环到没有文件为止
            a = a + 1
            ReDim Preserve Files(1 To a)
            Files(a) = Path & sPath                                 '将文件目录和文件名组合,并存放到数组中
            List1.AddItem Files(a)                                  '加入list控件中
            sPath = Dir                                             '查找下一个文件

            DoEvents                                                '让出控制权
        Loop

        sPath = Dir(Path & "\", vbDirectory)                        '查找第一个文件夹

        Do While Len(sPath)                                         '循环到没有文件夹为止

            If Left(sPath, 1) <> "." Then                           '为了防止重复查找
                If GetAttr(Path & "\" & sPath) And vbDirectory Then '如果是文件夹则。。。。。。
                    b = b + 1
                    ReDim Preserve Folder(1 To b)
                    Folder(b) = Path & sPath & "\"                  '将目录和文件夹名称组合形成新的目录,并存放到数组中
                End If
            End If

            sPath = Dir                                             '查找下一个文件夹

            DoEvents                                                '让出控制权
        Loop

        For c = 1 To b                                              '使用递归方法,遍历所有目录
            SearchFiles Folder(c), FileType
        Next

End Function

Private Sub Form_Load()
   SearchFiles "C:\Program Files\", "*.*"                           '查找所有文件
'  SearchFiles "C:\Program Files\", "*.exe"                         '查找所有exe文件
'  SearchFiles "C:\Program Files\", "*in*.exe"                      '查找文件名中包含有 in 的exe文件
End Sub

'==================================查看文件夹下所有的文件(包括文件夹,包括子目录)==================================
'代码出外:http://www.newxing.com/Tech/Program/VisualBasic/724.html
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_DIR = &H18D
Private Const DDL_ARCHIVE = &H20          '存档文件
Private Const DDL_DIRECTORY = &H10        '目录
Private Const DDL_DRIVES = &H4000         '驱动器
Private Const DDL_EXCLUSIVE = &H8000      '不相容的位。如果设置了这个位,则只列出指定类型的文件;否则列出普通文件和指定类型的文件。
Private Const DDL_HIDDEN = &H2            '隐藏文件
Private Const DDL_POSTMSGS = &H2000       'LB_DIR 标志。如果设置了LB_DIR标志,Windows将DlgDirList产生的消息放入应用程序的队列,否则,它们被直接发送到对话框过程。
Private Const DDL_READONLY = &H1          '只读文件
Private Const DDL_READWRITE = &H0         '可读写
Private Const DDL_SYSTEM = &H4            '系统文件

Private Sub Form_Load()
    SendMessage List1.hwnd, LB_DIR, DDL_DIRECTORY Or DDL_EXCLUSIVE, ByVal "D:\My Documents\*"   '枚举目录
    SendMessage List1.hwnd, LB_DIR, DDL_READWRITE Or DDL_ARCHIVE, ByVal "D:\My Documents\*.exe" '枚举exe文件
End Sub


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com