Source code for Issue Number 80

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just create a new Class Module and then paste this source code into it. You should name the class cFindFiles.

'----------------------------------------------------------------------
'
'   Module Name:    cFindFiles
'   Written By:     Tracy Martin
'   Modifications:     C&D Programming Corp.
'   Create Date:    2/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

' Note that files returned from this class are in no particular order.

' Constants needed for API calls
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1

' File Attribute constants
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100


' Time structures needed for API calls
Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type


Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type


' Structure needed for FindFile APIs
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


' Declarations for API calls
Private Declare Function APIFindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function APIFindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function APIFindClose Lib "kernel32" Alias "FindClose" (ByVal hFindFile As Long) As Long


Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long


Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, lpFilePart As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long


' Globals needed for inter-function communication
Private FileData As WIN32_FIND_DATA     ' File detail data returned by API calls
Private sFullPath As String             ' Full (LFN) path to directory where files are found, minus file name
Private sShortPath As String            ' Full (8.3) path to directory where files are found, minus file name
Private hFind As Long                   ' Handle to file enumeration
Private StrMonth(12) As String          ' Short month names, used in date conversion


Public Function FindFile(ByVal pstrName As String) As Boolean
' FindFile: search for a file or directory
'
' Incoming parameters:
'     pstrName (String): File to search for. This may contain any, all, or none of the following:
'                            a fully qualified path
'                            a specific file name
'                            wildcards (within file name only)
'                        If this item is null, "*.*" will be substituted.
'                        If no path is specified, the current directory will be searched.
'
' Returned parameters:
'    Boolean: True if search is successful, false otherwise
'
' Global Variables Modified:
'   hFind:              Holds handle to opened Find for later use
'   FileData:           Receives file data returned from API
'   sFullPath:          Holds full path to located file, minus file name, for future use
'   sShortPath:         Holds short (8.3) path to located file, minus file name, for future use
'
' Local Variables:
'   nPathLen (Long):    Length of path name (used for creating buffer)
'   pName (Long):       Unused variable (pointer to short name - actual pointer, not offset)
'   iPos (Integer):     Offset of "\" when separating path and file name
'   sName (String):     Used to separate file name from path name
'   bCont (Boolean):    Used to detect when to end loop separating path and file name


    Dim nPathLen As Long, pName As Long
    Dim sName As String
    Dim bCont As Boolean, iPos As Integer


' If hFind is not null, then a previous search was not closed, so close it now.
    If hFind <> 0 Then
        FindClose
    End If


' If pstrName is null, replace it with "*.*"
    If pstrName = "" Then pstrName = "*.*"


' If a path with no file was specified, append "*.*"
    If Right(pstrName, 1) = "\" Then
        pstrName = pstrName + "*.*"
    End If

    hFind = APIFindFirstFile(pstrName, FileData)


' If hFind is -1 (INVALID_HANDLE_VALUE), the search failed
    If hFind = INVALID_HANDLE_VALUE Then
        hFind = 0
        FindFile = False
        Exit Function
    End If


' Clean up remnants left by the API, such as null characters, and convert returned time structures from UTC to local
    CleanFileData


' Get the full path for the search, so that we can use it later
    nPathLen = GetFullPathName(pstrName, 0, sFullPath, pName)
    sFullPath = String(nPathLen, " ")
    nPathLen = GetFullPathName(pstrName, nPathLen, sFullPath, pName)


' Clean these up (remove nulls, etc.)
    sFullPath = Left(sFullPath, InStr(sFullPath, Chr(0)) - 1)
    sName = sFullPath

' Cut the filename off the path, so that we have a "generic" path for the search set
    sFullPath = ""
    bCont = True
    While bCont
        iPos = InStr(sName, "\")
        If iPos = 0 Then
            bCont = False
        Else
            sFullPath = sFullPath & Left(sName, iPos)
            sName = Right(sName, Len(sName) - iPos)
        End If
    Wend

' Get the "short" path (8.3 names) for the search, so we can use it later
    nPathLen = GetShortPathName(sFullPath, sShortPath, 0)
    sShortPath = String(nPathLen, " ")
    nPathLen = GetShortPathName(sFullPath, sShortPath, 0)


' Clean it up (remove nulls, etc.)
    sShortPath = Left(sShortPath, InStr(sShortPath, Chr(0)))
    If sShortPath = "" Then sShortPath = sFullPath
    If Right(sShortPath, 1) <> "\" Then sShortPath = sShortPath + "\"


' If we made it here, we were successful, so get out
    FindFile = True


End Function


Public Function FindNextFile() As Boolean
' FindNextFile: continue the search started with FindFile
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Boolean:           True if search is successful, false otherwise
'
' Global Variables Modified:
'   FileData:           Receives file data returned from API
'
' Local Variables:
'   bResult (Boolean):  Holds result code from API call


    Dim bResult As Boolean


' If hFind is null, the search was closed - must call FindFile before FindNextFile
    If hFind = 0 Then
        FindNextFile = False
        Exit Function
    End If


    bResult = APIFindNextFile(hFind, FileData)


' If the search was successful, clean up the returned data
    If bResult Then
        CleanFileData
    End If


    FindNextFile = bResult


End Function


Public Sub FindClose()
' FindClose: Close the current search
'
' Incoming parameters:
'     
'
' Returned parameters:
'    
'
' Global Variables Modified:
'   hFind:              Cleared to indicate that find is closed
'   sFullPath:          Cleared in preparation for next find
'   sShortPath:         Cleared in preparation for next find


' Dump our previously saved paths, as they are no longer needed.
    sFullPath = ""
    sShortPath = ""


' if hFind is Null, the search is already closed - no need to do it again.
    If hFind <> 0 Then
        APIFindClose hFind
        hFind = 0
    End If


End Sub


Public Property Get GetAttributes() As Long
' GetAttributes: Return the attribute data for the currently "found" file
'
' Incoming parameters:
'     
'
' Returned Parameters:
'     Long: Attribute data (returned from API as DWORD)


    GetAttributes = FileData.dwFileAttributes
End Property




Public Property Get GetLastWriteTime() As Date
' GetLastWriteTime: Return the date/time the file was last written to. May not be supported on all file systems
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Date: The last write date for the file, adjusted for local time zone
'
' Local Variables:
'   WriteTime (SYSTEMTIME): Used while converting date/time from file system format to VB format


    Dim WriteTime As SYSTEMTIME


    If (FileTimeToSystemTime(FileData.ftLastWriteTime, WriteTime)) Then
        GetLastWriteTime = CDate(StrMonth(WriteTime.wMonth) & " " & CStr(WriteTime.wDay) & ", " & CStr(WriteTime.wYear) & " " & CStr(WriteTime.wHour) & ":" & CStr(WriteTime.wMinute) & ":" & CStr(WriteTime.wSecond))
    Else
        GetLastWriteTime = CDate("")
    End If


End Property


Public Property Get GetLastAccessTime() As Date
' GetLastAccessTime: Return the date/time the file was last accessed/read. May not be supported on all file systems
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Date: The last access date for the file, adjusted for local time zone
'
' Local Variables:
'   AccessTime (SYSTEMTIME): Used while converting date/time from file system format to VB format

    Dim AccessTime As SYSTEMTIME


    If (FileTimeToSystemTime(FileData.ftLastAccessTime, AccessTime)) Then
        GetLastAccessTime = CDate(StrMonth(AccessTime.wMonth) & " " & CStr(AccessTime.wDay) & ", " & CStr(AccessTime.wYear) & " " & CStr(AccessTime.wHour) & ":" & CStr(AccessTime.wMinute) & ":" & CStr(AccessTime.wSecond))
    Else
        GetLastAccessTime = CDate("")
    End If


End Property


Public Property Get GetCreationDate() As Date
' GetCreationDate: Return the date/time the file was created. May not be supported on all file systems
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Date: The creation date for the file, adjusted for local time zone
'
' Local Variables:
'   CreateTime (SYSTEMTIME): Used while converting date/time from file system format to VB format


    Dim CreateTime As SYSTEMTIME


    If (FileTimeToSystemTime(FileData.ftCreationTime, CreateTime)) Then
        GetCreationDate = CDate(StrMonth(CreateTime.wMonth) & " " & CStr(CreateTime.wDay) & ", " & CStr(CreateTime.wYear) & " " & CStr(CreateTime.wHour) & ":" & CStr(CreateTime.wMinute) & ":" & CStr(CreateTime.wSecond))
    Else
        GetCreationDate = CDate("")
    End If


End Property


Public Property Get GetRoot() As String
' GetRoot: Return the path (minus file name) where the file was found
'
' Incoming parameters:
'     
'
' Returned parameters:
'    String: The path (minus file name) to the file
'
    GetRoot = Trim(sFullPath)


End Property



Public Property Get GetFilePath() As String
' GetFilePath: Return the full path to the file, including the filename and extension
'
' Incoming parameters:
'     
'
' Returned parameters:
'    String: The full path to the file
'
    GetFilePath = Trim(sFullPath) & Trim(FileData.cFileName)


End Property


Public Property Get GetFileName() As String
' GetFileName: Return the name, including extension, of the currently "found" file
'
' Incoming parameters:
'     
'
' Returned parameters:
'    String: The filename, including extension, of the file
'
    GetFileName = Trim(FileData.cFileName)


End Property


Public Property Get GetShortPath() As String
' GetShortPath: Return the short (8.3) path to the file, including the filename and extension
'
' Incoming parameters:
'     
'
' Returned parameters:
'    String: The short (8.3) path to the file
'
    GetShortPath = Trim(sShortPath) & Trim(FileData.cAlternate)


End Property


Public Property Get GetShortName() As String
' GetShortName: Return the short (8.3) name, including extension, of the currently "found" file
'
' Incoming parameters:
'     
'
' Returned parameters:
'    String: The short (8.3) filename, including extension, of the file
'
    GetShortName = Trim(FileData.cAlternate)


End Property


Public Property Get GetLength() As Long
' GetLength: Return the size, in bytes, of the currently "found" file
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Long: Size, in bytes, of the file
'
    GetLength = FileData.nFileSizeLow


End Property


Public Property Get GetLength64() As Variant
' GetLength64: Return the size, in bytes, of the currently "found" file
'
' Incoming parameters:
'     
'
' Returned parameters:
'    Variant: Size, in bytes, of the file
'
' Note: The size returned by this function may be too large for a Long integer variable


    If FileData.nFileSizeHigh = 0 Then
        GetLength64 = GetLength
        Exit Property
    End If


    GetLength64 = (FileData.nFileSizeHigh * 2E+32) + FileData.nFileSizeLow


End Property


Private Sub CleanFileData()
' CleanFileData: Remove trailing nulls from strings, and adjust dates/times for local time zones
'
' Incoming parameters:
'     
'
' Returned parameters:
'    
'
' Global Variables Modified:
'   FileData:           File data returned by API - nulls removed, dates converted from UTC to local time zone
'
' Local Variables:
'   TempTime (FILETIME):    Temp variable used during date conversion
'   bResult (Boolean):      Return value from API calls (unused)
'
' Note: This routine modifies the FindData structure returned by the FindFirstFile and FindNextFile API calls
'
    Dim TempTime As FILETIME
    Dim bResult As Boolean


' Strip off trailing nulls and/or other garbage that may follow first null character (null character is terminator for string returned from API)
    FileData.cAlternate = Trim(Left(FileData.cAlternate, InStr(FileData.cAlternate, Chr(0)) - 1))
    FileData.cFileName = Trim(Left(FileData.cFileName, InStr(FileData.cFileName, Chr(0)) - 1))


' Convert FILETIME structures from UTC to local time zone
    TempTime = FileData.ftCreationTime
    bResult = FileTimeToLocalFileTime(TempTime, FileData.ftCreationTime)
    TempTime = FileData.ftLastAccessTime
    bResult = FileTimeToLocalFileTime(TempTime, FileData.ftLastAccessTime)
    TempTime = FileData.ftLastWriteTime
    bResult = FileTimeToLocalFileTime(TempTime, FileData.ftLastWriteTime)
End Sub


Private Sub Class_Initialize()
' Short month names used in creating string dates, for conversion to VB Date format
    StrMonth(1) = "Jan"
    StrMonth(2) = "Feb"
    StrMonth(3) = "Mar"
    StrMonth(4) = "Apr"
    StrMonth(5) = "May"
    StrMonth(6) = "Jun"
    StrMonth(7) = "Jul"
    StrMonth(8) = "Aug"
    StrMonth(9) = "Sep"
    StrMonth(10) = "Oct"
    StrMonth(11) = "Nov"
    StrMonth(12) = "Dec"
End Sub


Private Sub Class_Terminate()
' Close any open file search
    FindClose
End Sub