Tracy Martin is the winner of an annual subscription to Code of the Week for submitting this weeks source code.
For the next month we are offering a free annual subscription to anyone that submits source code for an issue which gets published. If you have some useful source code that would be valuable for our members, fill out the form at http://www.codeoftheweek.com/submissions.html
Please make sure all source code is tested and is in working condition. We are looking for all types of source from database access routines to API calls to graphics routines. We are not looking for one or two lines tricks at this time (this will be a future offering) . The source code should be at least 10 or 15 lines of long, preferably longer. It should be commented or at least readable by the average programmer.
If you are currently a member of Code of the Week we will extend your subscription an additional year.
Download a free copy of NetMon - Your Internet Performance Monitor at http://www.codeoftheweek.com/netmon/index.html
In this issue we show a very fast way to search for files.
This source code is designed for VB 4.0 32-bit and up. Questions? Email us at questions@codeoftheweek.com.
The cFindFiles class module was written by Tracy Martin with some small modifications by C&D Programming Corp. It contains a couple of methods for getting files and information about files it has found.
If you have any questions about using this class, let us know at questions@codeoftheweek.com
Public Function FindFile(ByVal pstrName As String) As Boolean
This is the start of the search routine. You would call this with a parameter such as "e:\temp\*.xls" to find all files with the extension xls. It will return True if a file was found and False if it was not found. After calling this function you can use any of the Properties listed below to get additional information provided it returned True.
Public Function FindNextFile() As Boolean
This routine needs to be called until it returns False in order to retrieve all the matching files. After calling this function you can use any of the Properties listed below to get additional information provided it returned True.
Completes one search and allows you to begin another.
See each function/properties for details.
The below sample describes how to use the cFindFiles class. It will show how many files are located in the E:\TEMP directory.
Option Explicit
Private Sub FindTest()
Dim Fnd As cFindFiles
Dim bContinue As Boolean
Dim lCount As Long
Set Fnd = New cFindFiles
bContinue = Fnd.FindFile("e:\temp\*.*")
While bContinue
lCount = lCount + 1
bContinue = Fnd.FindNextFile
Wend
MsgBox "Found " & lCount & " matching files."
End Sub
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