finder.cls

可准确的查找到系统所存在的文件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Finder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'/************************************************************/
'/*                     == 类模块说明 ==                     */
'/*                                                          */
'/*     这个类模块可以在目录及子目录中进行文件查找。         */
'/*                                                          */
'/* 属性：                                                   */
'/*     FileCount - 找到的文件数量。                         */
'/*     Filename - 要查找的文件名。它即可以是一个准确的文件  */
'/*         名称，也可以是带有通配符的文件类型过滤器，如：   */
'/*         *.exe;*.txt。其中各类型间的分隔符可以通过FS属性  */
'/*         自定义。                                         */
'/*     Filenames - 这是一个集合属性，它保存了所有找到的文件 */
'/*         名称。                                           */
'/*     FindPath - 要进行搜索的起始文件夹名称。              */
'/*     FS - 文件过滤器分隔符,缺省为“;”。参见Filename属性。*/
'/*                                                          */
'/* 方法:                                                    */
'/*     StartFind - 开始进行查找。在查找前需要设置Filename和 */
'/*         FindPath属性。                                   */
'/*     StopFind - 停止查找过程。                            */
'/*                                                          */
'/* 事件:                                                    */
'/*     FindedFile - 找到一个匹配的文件时就引发该事件,并将找 */
'/*         到的文件名做为参数传递。                         */
'/*     ChangPath - 每搜索一个子文件夹时引发该事件, 并将这个 */
'/*         文件夹做为参数进行传递。                         */
'/*                                                          */
'/*     完全可以添加更多的属性以获得更多的信息和功能，如记录 */
'/* 找到的文件总尺寸、搜索的文件夹数量、只查找某属性的文件、 */
'/* 查找指定大小的文件或哪个日期段内的文件等。这里只演示最基 */
'/* 本的功能，因此略过了这些信息。如有需要可与我联系。       */
'/*                                                          */
'/*                                       2002.12.17         */
'/*                                                          */
'/* ======================================================== */
'/*                     ★ 本站声明 ★                       */
'/*                                                          */
'/*     如果您要转摘本代码，请保留原代码中的所有内容，包括注 */
'/* 释部分，以示对作者劳动的尊重，谢谢！如发现代码有问题，可 */
'/* 与作者联系。                                             */
'/*     本代码作者：ＶＢ超市站长－宋耀武                     */
'/*     http://vbsupermarket.yeah.net                        */
'/*     E-Mail: [e-mail]                       */
'/*             [e-mail]                      */
'/************************************************************/

'/*********************/
'/*  1. 常量声明部分  */
'/*********************/
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

'/*********************/
'/*  2. 类型声明部分  */
'/*********************/
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private 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

'/*********************/
'/*  3. 变量声明部分  */
'/*********************/
'** 保持属性值的局部变量
Private mvarFilename As String
Private mvarFindPath As String
Private mvarFS As String
Private mvarFileCount As Long
Private mvarFilenames As Collection
 
Private bStop As Boolean

'/*********************/
'/*  4. 函数声明部分  */
'/*********************/
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

'要引发该事件，请遵循下列语法使用 RaiseEvent:
'RaiseEvent FindedFile[(arg1, arg2, ... , argn)]
Public Event FindedFile(NewFilename As String)
'要引发该事件，请遵循下列语法使用 RaiseEvent:
'RaiseEvent ChangPath[(arg1, arg2, ... , argn)]
Public Event ChangPath(NewPath As String)

'***********************************
'   只保留第一个空字符以前的字符
'***********************************
Private Function DeleteNulls(OriginalString As String) As String
    If (InStr(OriginalString, Chr(0)) > 0) Then
        OriginalString = Left(OriginalString, InStr(OriginalString, Chr(0)) - 1)
    End If
    DeleteNulls = OriginalString
End Function

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%     这个函数就是完成查找过程的主要部分, 请仔细阅读   %%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'**********************************************************
'   查找文件。这是一个递归函数
'**********************************************************
'   参数说明:
'       sPath - 要搜索的路径
'       sSearchStr - 要查找的文件，它支持通配符及多种类型文件
'**********************************************************
Public Function FindFiles(sPath As String, sSearchStr As String)
    Dim sFilename As String     ' 当前步骤找到的文件名
    Dim sDirName As String      ' 当前步骤找到的子文件夹名
    Dim dirNames() As String    ' 保存子文件夹名称
    Dim nDir As Integer         ' 子文件夹数量
    Dim I As Long, J As Long
    Dim hSearch As Long         ' FindFirstFile函数返回的句柄
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Long
    Dim sFilter() As String     ' 分解后的文件过滤器数组
    If bStop Then Exit Function
    
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(sPath & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        '** 此过程将收集到当前目录中的所有子目录名
        Do While Cont
            sDirName = DeleteNulls(WFD.cFileName)
            'MsgBox sDirName
            'Name "E:\1\" & sDirName As "E:\1\1" & sDirName
            '** 判断是否是当前目录或父目录
            If (sDirName <> ".") And (sDirName <> "..") Then
                'Name "E:\1\" & sDirName As "E:\1\1" & sDirName
                '** 检查文件属性，如果是目录则保存到数组
'                Lenth = Lenth + FileLen(sPath & sDirName)
                If GetFileAttributes(sPath & sDirName) And FILE_ATTRIBUTE_DIRECTORY Then '常量为16，即文件夹，32则为文件，文件含其他属性则为30多。
                    dirNames(nDir) = sDirName
                    'PathCount = PathCount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                End If
            End If
            Cont = FindNextFile(hSearch, WFD)   ' 找下一个目录
            DoEvents
        Loop
        Cont = FindClose(hSearch)
    End If
    
    '**  此过程将找到当前目录中的所有与指定文件相匹配的文件
    sFilter = Split(sSearchStr, FS) '即Split的功能就是将sSearchstr中的所有字符中间心FS即（;）为界限全部存在sFilter数组中
    For J = 0 To UBound(sFilter)
        hSearch = FindFirstFile(sPath & sFilter(J), WFD)
        Cont = True
        If hSearch <> INVALID_HANDLE_VALUE Then
            While Cont
                sFilename = DeleteNulls(WFD.cFileName)
                If (sFilename <> ".") And (sFilename <> "..") Then
                    FileCount = FileCount + 1
                    RaiseEvent FindedFile(sPath & sFilename)   '%% 引发FindedFile事件，并传递找到的文件名 %%
                    Filenames.Add sPath & sFilename            ' 保存找到的文件名
                End If
                Cont = FindNextFile(hSearch, WFD)   ' 查找下一个文件
                DoEvents
            Wend
            Cont = FindClose(hSearch)
        End If
    Next J
    
    '** 如果当前目录中含有子目录，则进行递归调用，进行收搜
    If nDir > 0 Then
        For I = 0 To nDir - 1
            RaiseEvent ChangPath(sPath & dirNames(I) & "\")     '%% 引发ChangPath事件，并传递要搜索的目录名 %%
            FindFiles sPath & dirNames(I) & "\", sSearchStr
            DoEvents
        Next I
    End If
    
End Function

Public Property Set Filenames(ByVal vData As Collection)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.Filenames = Form1
    Set mvarFilenames = vData
End Property

Public Property Get Filenames() As Collection
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Filenames
    Set Filenames = mvarFilenames
End Property

Public Sub StopFind()
    bStop = True
End Sub

'***********************************
'   开始查找文件
'***********************************
Public Sub StartFind()
    FindFiles FindPath, Filename
End Sub

Public Property Let FileCount(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.FileCount = 5
    mvarFileCount = vData
End Property

Public Property Get FileCount() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.FileCount
    FileCount = mvarFileCount
End Property

Public Property Let FS(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.FS = 5
    mvarFS = vData
End Property

Public Property Get FS() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.FS
    FS = mvarFS
End Property

Public Property Let FindPath(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.FindPath = 5
    mvarFindPath = vData
    If Right(mvarFindPath, 1) <> "\" Then mvarFindPath = mvarFindPath & "\"
End Property

Public Property Get FindPath() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.FindPath
    FindPath = mvarFindPath
End Property

Public Property Let Filename(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Filename = 5
    mvarFilename = vData
End Property

Public Property Get Filename() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Filename
    Filename = mvarFilename
End Property

Private Sub Class_Initialize()
    FS = ";"
    Set Filenames = New Collection
End Sub