• Home
 · 
• Windows API Call/Explanation
 · 
• General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile.

General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile.

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




Rate General Fast,multipurpose,Event driven Class to Find Files using API FindFirstFile,FindNextFile.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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