VB中枚举指定目录下所有文件的方法

类别:.NET开发 点击:0 评论:0 推荐:

有同学问我这个问题,我就把代码贴在这里吧。

Module1.bas文件:
Public Const MAX_PATH = 260

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const INVALID_HANDLE_VALUE = -1


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 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 Function GetFullAllFileFilter(Directory As String) As String
    GetFullAllFileFilter = Directory + "\*.*"
End Function


frmMain.frm文件:
VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Enum Files Demo"
   ClientHeight    =   4770
   ClientLeft      =   3210
   ClientTop       =   1905
   ClientWidth     =   4920
   BeginProperty Font
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4770
   ScaleWidth      =   4920
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdList
      Caption         =   "&EnumFiles"
      Height          =   375
      Left            =   3600
      TabIndex        =   3
      Top             =   1800
      Width           =   1215
   End
   Begin VB.DirListBox Dir
      Height          =   1140
      Left            =   0
      TabIndex        =   2
      Top             =   480
      Width           =   4935
   End
   Begin VB.DriveListBox Drive
      Height          =   300
      Left            =   0
      TabIndex        =   1
      Top             =   120
      Width           =   4935
   End
   Begin VB.ListBox lstFileNames
      Height          =   2400
      ItemData        =   "frmMain.frx":0000
      Left            =   0
      List            =   "frmMain.frx":0002
      TabIndex        =   0
      Top             =   2280
      Width           =   4935
   End
   Begin VB.Label Label1
      Caption         =   "Click EnumFiles button to list all files in specified directory."
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   1680
      Width           =   3375
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdList_Click()
    Dim lpFileData As WIN32_FIND_DATA       ' 保存找到的文件的信息
    Dim hFindFile As Long                   ' 文件查找句柄
    Dim FindPattern As String               ' 查询的文件模式
    Dim tmp As Boolean
   
    ' 获得模式
    FindPattern = GetFullAllFileFilter(Dir.Path)
   
    ' 查找第一个文件
    hFindFile = FindFirstFile(FindPattern, lpFileData)
   
    ' 如果没有找到
    If hFindFile = INVALID_HANDLE_VALUE Then
        Exit Sub
    End If
   
    ' 清除列表
    lstFileNames.Clear
   
    ' 设置临时变量
    tmp = True
   
    Do While tmp
        ' 如果找到的是文件而不是目录
        '(如果连隐藏文件都要一并找出,该条件改为:
        ' If lpFileData.dwFileAttributes And (FILE_ATTRIBUTE_ARCHIVE OR FILE_ATTRIBUTE_HIDDEN) Then ...)
        If lpFileData.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE Then
            ' 将文件名添加到列表中
            lstFileNames.AddItem lpFileData.cFileName
        End If
        ' 查找下一个文件
        tmp = FindNextFile(hFindFile, lpFileData)
    Loop
    ' 全部查询完毕,关闭句柄
    FindClose hFindFile
End Sub

Private Sub Drive_Change()
    Dir.Path = Drive.Drive
End Sub

Private Sub Form_Load()
    Dir.Path = Drive.Drive
End Sub

本文地址:http://com.8s8s.com/it/it43384.htm