by Ulhas Aswar (4 Submissions)
Category: Windows API Call/Explanation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 3rd November 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile.
API Declarations
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As Long
Const rDayZeroBias As Double = 109205# ' Abs(CDbl(#01-01-1601#))
Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#
Const MAX_PATH = 260
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As Currency
ftLastAccessTime As Currency
ftLastWriteTime As Currency
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
cPath As String * MAX_PATH
End Type
Function Win32ToVbTime(ft As Currency) As Date
Dim ftl As Currency
' Call API to convert from UTC time to local time
If FileTimeToLocalFileTime(ft, ftl) Then
' Local time is nanoseconds since 01-01-1601
' In Currency that comes out as milliseconds
' Divide by milliseconds per day to get days since 1601
' Subtract days from 1601 to 1899 to get VB Date equivalent
Win32ToVbTime = CDate((ftl / rMillisecondPerDay) - rDayZeroBias)
Else
MsgBox Err.LastDllError
End If
End Function
VBcoders
'Usage:
'Set mFindList = mFind.FindFilesAPI(mTempPath", "*.txt")
'Enter Following Code in UUFind.cls
Option Explicit
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
Public Event UUFileFound(ByVal UUFileName As String, ByVal UUFilePath As String, ByVal UUFileSize As Long)
Public Event UUFindComplete(ByVal UUTotalFolders As String, ByVal UUTotalFiles As String, ByVal UUTotalSize As Long)
'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
Dim mDirCol As UUFindList
'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
Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Public Function FindFilesAPI(Path As String, SearchStr As String) As UUFindList
Dim mPath As String
Dim mSearchStr As String
Dim mFileCount As Integer
Dim mDirCount As Integer
Dim mTotalSize As Long
Set mDirCol = New UUFindList
mPath = Path
mSearchStr = SearchStr
mTotalSize = FindFilesAPIX(mPath, mSearchStr, mFileCount, mDirCount)
Set FindFilesAPI = mDirCol
RaiseEvent UUFindComplete(mDirCount + 1, mFileCount, mTotalSize)
End Function
Private Function FindFilesAPIX(Path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
Dim fName As String
Dim dName As String
Dim dNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim dNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
dName = StripNulls(WFD.cFileName)
If (dName <> ".") And (dName <> "..") Then
If GetFileAttributes(Path & dName) And FILE_ATTRIBUTE_DIRECTORY Then
dNames(nDir) = dName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
fName = StripNulls(WFD.cFileName)
If (fName <> ".") And (fName <> "..") Then
FindFilesAPIX = FindFilesAPIX + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
RaiseEvent UUFileFound(fName, Path, (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow)
mDirCol.Add WFD.dwFileAttributes, Win32ToVbTime(WFD.ftCreationTime), Win32ToVbTime(WFD.ftLastAccessTime), Win32ToVbTime(WFD.ftLastWriteTime), WFD.nFileSizeLow, fName, Path
DoEvents
End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPIX = FindFilesAPIX + FindFilesAPIX(Path & dNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
*****
'Enter following code in UUFindList.cls
Option Explicit
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
Private mCol As New Collection
Public Function Add(lAttrib As Long, dtCreationTime As Date, dtLastAccessTime As Date, dtLastWriteTime As Date, lFileSize As Long, sFilename As String, sPath As String) As UUFindItem
Dim newItem As New UUFindItem
With newItem
.Archive = (lAttrib And FILE_ATTRIBUTE_ARCHIVE)
.Compressed = (lAttrib And FILE_ATTRIBUTE_COMPRESSED)
'.Directory = (lAttrib And FILE_ATTRIBUTE_DIRECTORY)
If (lAttrib And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
.Directory = True
End If
.Hidden = (lAttrib And FILE_ATTRIBUTE_HIDDEN)
.Normal = (lAttrib And FILE_ATTRIBUTE_NORMAL)
.Offline = (lAttrib And FILE_ATTRIBUTE_OFFLINE)
.ReadOnly = (lAttrib And FILE_ATTRIBUTE_READONLY)
.System = (lAttrib And FILE_ATTRIBUTE_SYSTEM)
.Temporary = (lAttrib And FILE_ATTRIBUTE_TEMPORARY)
.CreationTime = dtCreationTime
.LastAccessTime = dtLastAccessTime
.LastWriteTime = dtLastWriteTime
.FileSize = lFileSize
.Filename = sFilename
.Path = sPath
End With
mCol.Add newItem, CStr(mCol.Count)
End Function
Public Function Clear()
Dim lIndex As Long
If mCol.Count > 0 Then
For lIndex = mCol.Count To 1 Step -1
mCol.Remove lIndex
Next
End If
End Function
Public Function item(Index As Variant) As UUFindItem
Set item = mCol(Index)
End Function
Public Function Count() As Long
Count = mCol.Count
End Function
Public Function NewEnum() As IUnknown
Set NewEnum = mCol.[_NewEnum]
End Function
******
'Enter following code in UUFindItem.cls
Option Explicit
Public ReadOnly As Boolean
Public Hidden As Boolean
Public System As Boolean
Public Directory As Boolean
Public Archive As Boolean
Public Normal As Boolean
Public Temporary As Boolean
Public Compressed As Boolean
Public Offline As Boolean
Public CreationTime As Date
Public LastAccessTime As Date
Public LastWriteTime As Date
Public FileSize As Long
Public Filename As String
Public Path As String
No comments have been posted about General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile.. Why not be the first to post a comment about General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile..
