GFFileList/GFFileListcls.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = ‑1 'True
END
Attribute VB_Name = "GFFileListcls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2003 by Louis. Behaves like a VB FileListBox, similar to GFDirectoryList4.
'File access functions taken from GFFileAccess (see there for further information).
'
'IMPORTANT: the returned file names are NOT sorted in any way.
'
'GFFileAccess_GetDirFileSizeTotal
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 FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'GFFileAccess_GetDirFileSizeTotal
Private Const MAX_PATH = 260
'Refresh
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
'GFFileAccess_GetDirFileSizeTotal
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
'GFFileAccess_GetDirFileSizeTotal
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
'GFFileListStruct ‑ general data storage of this object
Private Type GFFileListStruct
    PathCurrent As String
    PatternCurrent As String
    DisplayArchiveFlag As Boolean
    DisplayHiddenFlag As Boolean
    DisplayReadOnlyFlag As Boolean
    DisplaySystemFlag As Boolean
End Type
Dim GFFileListStructVar As GFFileListStruct
'other
Dim FileNameNumber As Integer
Dim FileNameArray() As String

Private Sub Class_Initialize()
    'on error resume next
    'preset
    Me.Path = App.Path
    Me.Pattern = "*.*"
    Me.Archive = True
    Me.Hidden = False
    Me.ReadOnly = True
    Me.System = False
End Sub

Public Property Let Path(ByVal PathNew As String)
    'on error resume next
    If Not (Right$(PathNew, 1) = "\") Then PathNew = PathNew + "\"
    GFFileListStructVar.PathCurrent = PathNew
End Property

Public Property Set Path() As String
    'on error resume next
    '
    'NOTE: if the path is invalid then just no files will be found
    'when calling Refresh.
    '
    Path = GFFileListStructVar.PathCurrent
End Property

Public Property Let Pattern(ByVal PatternNew As String)
    'on error resume next
    GFFileListStructVar.PatternCurrent = PatternNew
End Property

Public Property Set Pattern() As String
    'on error resume next
    'Pattern = GFFileListStructVar.PatternCurrent
End Property

Public Property Let Archive(ByVal DisplayFlag As Boolean)
    'on error resume next
    GFFileListStructVar.DisplayArchiveFlag = DisplayFlag
End Property

Public Property Set Archive() As Boolean
    'on error resume next
    Archive = GFFileListStructVar.DisplayArchiveFlag
End Property

Public Property Let Hidden(ByVal DisplayFlag As Boolean)
    'on error resume next
    GFFileListStructVar.DisplayHiddenFlag = DisplayFlag
End Property

Public Property Set Hidden() As Boolean
    'on error resume next
    Hidden = GFFileListStructVar.DisplayHiddenFlag
End Property

Public Property Let ReadOnly(ByVal DisplayFlag As Boolean)
    'on error resume next
    GFFileListStructVar.DisplayReadOnlyFlag = DisplayFlag
End Property

Public Property Set ReadOnly() As Boolean
    'on error resume next
    ReadOnly = GFFileListStructVar.DisplayReadOnlyFlag
End Property

Public Property Let System(ByVal DisplayFlag As Boolean)
    'on error resume next
    GFFileListStructVar.DisplaySystemFlag = DisplayFlag
End Property

Public Property Set System() As Boolean
    'on error resume next
    System = GFFileListStructVar.DisplaySystemFlag
End Property

Public Sub Refresh()
    'on error resume next
    Dim FindFileHandle As Long
    Dim FileSizeTotal As Double
    Dim WIN32_FIND_DATAVar As WIN32_FIND_DATA
    Dim Temp As Long
    '
    'NOTE: this function is bloody fast, in tests it needed only few seconds
    'to get the names of over 30.000 files.
    '
    'reset
    FileNameNumber = 0 'reset
    'ReDim FileNameArray(1 To 1) As String 'reset
    'begin
    FindFileHandle = FindFirstFile(GFFileListStructVar.PathCurrent + GFFileListStructVar.PatternCurrent, WIN32_FIND_DATAVar)
    If FindFileHandle > 0& Then
ReDo:
        With WIN32_FIND_DATAVar
            '
            If (.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                GoTo Jump: 'we want file names only
            End If
            If (.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) Then
                If GFFileListStructVar.DisplayArchiveFlag = False Then GoTo Jump:
            End If
            If (.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) Then
                If GFFileListStructVar.DisplayHiddenFlag = False Then GoTo Jump:
            End If
            If (.dwFileAttributes And FILE_ATTRIBUTE_READONLY) Then
                If GFFileListStructVar.DisplayReadOnlyFlag = False Then GoTo Jump:
            End If
            If (.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) Then
                If GFFileListStructVar.DisplaySystemFlag = False Then GoTo Jump:
            End If
            '
            FileNameNumber = FileNameNumber + 1
            If (FileNameNumber > 32767) Then Exit Sub 'use 32767, overflow
            If ((FileNameNumber ‑ 1) Mod 128) = 0 Then 'resize in steps to save CPU time
                ReDim Preserve FileNameArray(1 To (FileNameNumber + 127)) As String
            End If
            Temp = InStr(1, WIN32_FIND_DATAVar.cFileName, Chr$(0), vbBinaryCompare)
            If (Temp) Then
                FileNameArray(FileNameNumber) = Left$(WIN32_FIND_DATAVar.cFileName, Temp ‑ 1&)
            Else
                FileNameArray(FileNameNumber) = WIN32_FIND_DATAVar.cFileName
            End If
            '
        End With
Jump:
        If FindNextFile(FindFileHandle, WIN32_FIND_DATAVar) > 0& Then GoTo ReDo:
        Call FindClose(FindFileHandle)
        Exit Sub 'ok
    Else
        Exit Sub 'error (but already reset)
    End If
End Sub

Public Property Set ListCount() As Integer
    'on error resume next
    ListCount = FileNameNumber
End Property

Public Property Set List(ByVal ListIndex As Integer) As String
    'on error resume next
    '
    'NOTE: the file names are NOT sorted, they appear in chaotic order.
    '
    If Not ((ListIndex < 0) Or (ListIndex > FileNameNumber)) Then 'verify
        List = FileNameArray(ListIndex + 1) '0 to 1 based
    Else
        List = "" 'error
    End If
End Property


[END OF FILE]