GFFileList/Form1.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3015
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4635
   LinkTopic       =   "Form1"
   ScaleHeight     =   3015
   ScaleWidth      =   4635
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.FileListBox File1
      Enabled         =   0 'False
      Height          =   285
      Left            =   2400
      TabIndex        =   5
      Top             =   660
      Visible         =   0 'False
      Width           =   255
   End
   Begin VB.DirListBox GFDirectoryListDir
      Enabled         =   0 'False
      Height          =   315
      Left            =   2160
      TabIndex        =   4
      Top             =   660
      Visible         =   0 'False
      Width           =   195
   End
   Begin VB.CommandButton Command2
      Caption         =   "Overkill Test"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   1935
   End
   Begin VB.ListBox List1
      Height          =   1815
      Left            =   120
      TabIndex        =   3
      Top             =   1080
      Width           =   4395
   End
   Begin VB.CommandButton Command1
      Caption         =   "Get File Names"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1935
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   2160
      TabIndex        =   0
      Top             =   180
      Width           =   2355
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2003, 2004 by Louis.
'
'Downloaded from www.louis‑coder.com.
'Add GFFileListcls to your project, you can use it like a VB FileListBox.
'Please do not use the GFDirectoryList code of this form, it is obsolete.
'Use Louis Coder's GFDirectoryList4 instead (www.louis‑coder.com).
'
'GFDirectoryList
Dim GFDirectoryListNumber As Integer
Dim GFDirectoryListArray() As String
Dim GFDirectoryListCancelFlag As Boolean

Private Sub Command1_Click()
    'on error resume next
    Dim X As New GFFileListcls
    Dim FileLoop As Integer
    'reset
    List1.Clear
    'begin
    X.Path = Text1.Text
    X.Pattern = "*.*"
    X.Refresh
    For FileLoop = 1 To X.ListCount
        List1.AddItem X.List(FileLoop ‑ 1)
    Next FileLoop
End Sub

Private Sub Command2_Click()
    'on error resume next 'search all sub directories, verify the results of VB‑ and this FileListBox are equal (except order)
    Dim X As New GFFileListcls
    Dim DirNumber As Integer
    Dim DirArray() As String
    Dim DirLoop As Integer
    Dim FileLoop As Integer
    Dim CompareLoop As Integer
    'preset
    Call GFDirectoryList_Create(Text1.Text, True, DirArray(), DirNumber)
    'begin
    For DirLoop = 1 To DirNumber
        File1.Path = DirArray(DirLoop)
        File1.Refresh
        X.Path = DirArray(DirLoop)
        X.Refresh
        If Not (File1.ListCount = X.ListCount) Then MsgBox "TOO BAD"
        For FileLoop = 1 To File1.ListCount
            For CompareLoop = 1 To X.ListCount
                If UCase$(File1.List(FileLoop ‑ 1)) = UCase$(X.List(CompareLoop ‑ 1)) Then GoTo Jump:
            Next CompareLoop
            MsgBox "TOO BAD (2)"
Jump:
        Next FileLoop
    Next DirLoop
    MsgBox "YEAH, RESULT OF VB FILE LIST BOX IS THE SAME"
End Sub

'***GFDIRECTORYLIST***

Private Function GFDirectoryList_Create(ByVal ScanStartDir As String, ByVal AddScanStartDirFlag As Boolean, ByRef GFDirectoryListArrayPassed() As String, ByRef GFDirectoryListNumberPassed As Integer) As Boolean
    On Error GoTo Error: 'v2.0 (aborting possible); returns True if successful, False if error (i.e. ScanStartDir is invalid)
    Dim Temp As Long
    '
    'NOTE: this function initializes passed array with the full name of all
    'sub directories of ScanStartDir (format: x:\x\).
    '
    'reset
    GFDirectoryListNumber = 0 'reset
    ReDim GFDirectoryListArray(1 To 1) As String 'reset
    GFDirectoryListCancelFlag = False 'reset
    'scan beginning in ScanStartDir
    If AddScanStartDirFlag = True Then
        Call GFDirectoryList_AddItem(ScanStartDir)
    End If
    GFDirectoryListDir.Path = ScanStartDir
    GFDirectoryListDir.Refresh
    Call GFDirectoryList_Scan("")
    If GFDirectoryListCancelFlag = True Then GoTo Error:
    'transfer scan result
    GFDirectoryListNumberPassed = GFDirectoryListNumber
    If Not (GFDirectoryListNumberPassed = 0) Then 'verify
        ReDim GFDirectoryListArrayPassed(1 To GFDirectoryListNumberPassed) As String
    Else
        ReDim GFDirectoryListArrayPassed(1 To 1) As String
    End If
    For Temp = 1 To GFDirectoryListNumberPassed
        GFDirectoryListArrayPassed(Temp) = GFDirectoryListArray(Temp)
    Next Temp
    GFDirectoryList_Create = True 'ok
    Exit Function
Error:
    GFDirectoryList_Create = False 'error
    Exit Function
End Function

Private Sub GFDirectoryList_Scan(ByRef ScanDirOld As String)
    On Error GoTo Error: 'important (avoid endless loop)
    Dim ScanDirNumberTotal As Integer
    Dim ScanParentDir As String
    ScanDirNumberTotal = GFDirectoryListDir.ListCount
    Do While ScanDirNumberTotal > 0
        ScanParentDir = GFDirectoryListDir.Path
        If GFDirectoryListDir.ListCount > 0 Then
            GFDirectoryListDir.Path = GFDirectoryListDir.List(ScanDirNumberTotal ‑ 1) 'jump to Error: if i.e. network drive was disconnected
            GFDirectoryListDir.Refresh
            Call GFDirectoryList_AddItem(GFDirectoryListDir.Path)
            Call GFDirectoryList_Scan(ScanParentDir)
            If GFDirectoryListCancelFlag = True Then Exit Sub 'recursive call used, leave all subs
        End If
        ScanDirNumberTotal = ScanDirNumberTotal ‑ 1
    Loop
    If Not (ScanDirOld = "") Then
        GFDirectoryListDir.Path = ScanDirOld
        GFDirectoryListDir.Refresh 'DoEvents was removed
        Call GFDirectoryList_DoEvents(GFDirectoryListCancelFlag)
    End If
    Exit Sub
Error:
    'do nothing
    Exit Sub
End Sub

Private Sub GFDirectoryList_AddItem(ByVal Directory As String)
    'on error resume next
    If Not (GFDirectoryListNumber = 32767) Then 'verify
        GFDirectoryListNumber = GFDirectoryListNumber + 1
    Else
        Exit Sub 'error
    End If
    If Not (Right$(Directory, 1) = "\") Then Directory = Directory + "\" 'verify
    If ((GFDirectoryListNumber ‑ 1) Mod 128) = 0 Then 'resize array in steps to save CPU time
        ReDim Preserve GFDirectoryListArray(1 To GFDirectoryListNumber + 127) As String
    End If
    GFDirectoryListArray(GFDirectoryListNumber) = Directory
    Exit Sub
End Sub

Private Sub GFDirectoryList_DoEvents(ByRef CancelFlag As Boolean)
    'on error resume next
    '***DEBUG SPECIFIC***
    'do nothing
    '***END OF DEBUG SPECIFIC***
End Sub

'***END OF GFDIRECTORYLIST***


[END OF FILE]