Const KILO = 1024
Const MEG = 1048576
Const ROUNDDIGITS = 2

Const ROOTDOCPATH = "\my documents\"
Const DELIM = "|"

' Formats the date for the listview
Public Function FormatDate(ByVal theDate As Date) As String
    Dim out As String
    Dim today As String
    
    ' format the dates to use short format
    today = FormatDateTime(Now(), vbShortDate)
    out = FormatDateTime(theDate, vbShortDate)
    
    ' if the same as today, then format to show time
    ' Note this does not utilize the functions that use the
    ' user preferences.
    If (today = out) Then
        Dim hr, min
        hr = Hour(theDate)
        min = Minute(theDate)
        
        ' create the short time hh:mm a|p.
        If (hr > 12) Then
            out = CStr(hr - 12) & ":" & CStr(min) & " p"
        Else
            out = CStr(hr) & ":" & CStr(min) & " a"
        End If
    
    End If
    
    FormatDate = CStr(out)
    
End Function

' Creates a string with the date encoded which can be sorted using
' a sort that compare strings of characters
Public Function SortableDate(ByVal mydate As Date) As String
    
   Dim y, m, d, h, min, sec
   y = Chr(Year(mydate) - 1990 + 33)
   m = Chr(48 + Month(mydate))
   d = Chr(65 + Day(mydate))
   h = Chr(65 + Hour(mydate))
   min = Chr(65 + Minute(mydate))
   
   SortableDate = y + m + d + h + min
   'SortableDate = CStr(Chr(1990 - Year(mydate))) & CStr(Chr(33 + Month(mydate))) & CStr(Chr(33 + Day(mydate))) & CStr(Chr(33 + Hour(mydate))) & CStr(Chr(33 + Minute(mydate)))
    
End Function

' Formats the size of a file to minimize space requirements by
' using k and m designators for Kilobytes and Megabytes
Public Function FormatSize(ByVal size) As String
    Dim out As String
    Dim retval As Double
    
    ' Ok, if not numeric, you got me!
    If (Not IsNumeric(size)) Then
        FormatSize = "-"
        Exit Function
    End If
        
    ' Get size in megs
    retval = size / MEG
    If (retval > 1) Then
        FormatSize = CStr(Round(retval, ROUNDDIGITS)) & "m"
        Exit Function
    End If
    
    ' Get size in 10's of K.
    retval = size / (KILO * 10)
    If (retval > 1) Then
        FormatSize = CStr(Round(size / KILO, 0)) & "k"
        Exit Function
    End If
    
    ' get size in K
    retval = size / KILO
    If (retval > 1) Then
        FormatSize = CStr(Round(retval, ROUNDDIGITS)) & "k"
        Exit Function
    End If
    
    ' None of above, must be just bytes.
    retval = size
    FormatSize = CStr(retval) & "b"
    
End Function

' Returns as a DELIM separated string a list of the sub-directories below
' the startDirectory
Public Function ListSubdirectories(ByRef fso As FileSystem, ByVal startDirectory As String) As String
    Dim currDir As String
    Dim myDir As String
    Dim dirList As String
    Dim moreThanOne As Boolean
    
    dirList = ""
    moreThanOne = False
        
    If (startDirectory = "") Then
        currDir = ROOTDOCPATH & "*.*"
    Else
        currDir = startDirectory & "*.*"
     End If
    
    myDir = fso.Dir(currDir, fsAttrDirectory)
    
    Do While myDir <> ""
      
        If moreThanOne Then
            dirList = dirList & DELIM
        Else
            moreThanOne = True
        End If
        
        dirList = dirList & myDir
      
        myDir = fso.Dir
   
    Loop
   
    ListSubdirectories = dirList

End Function

' Loads a listview with the files from a set of directories.  The list of directories
' is in dirArray as a '|' (DELIM) separated list.  The key field in listview items is used to
' convey the full file path.
Public Sub LoadFileListBox(ByRef fso As FileSystem, ByRef lv As ListViewCtrl, ByRef dirArray As String, ByVal baseDir As String, ByVal ext As String)
    Dim myFile As String
    Dim i As Integer
    Dim str As String
    Dim a As ListItem
    Dim theDir As String
    Dim searchString As String
    Dim tmpArray As Variant
    Dim fdate As Date
   
    lv.ListItems.Clear
    
    If dirArray = "" Then
        tmpArray = Array("")
    Else
        'dirArray = "" & DELIM & dirArray
        tmpArray = Split(dirArray, DELIM)
    End If
        
    For i = LBound(tmpArray) To UBound(tmpArray)
        
        ' NEED TO FIGURE OUT THE "\" add problem
        theDir = baseDir & tmpArray(i)
        If (Not hasSlash(theDir)) Then
            theDir = theDir & "\"
        End If
        
        searchString = theDir & "*." & ext
   
        myFile = fso.Dir(searchString, fsAttrNormal)
      
        Do While myFile <> ""
      
            str = theDir & myFile
      
            If (fso.GetAttr(str) = fsAttrDirectory) Then
                Set a = lv.ListItems.Add(, str, StripExtension(myFile), , 2)
            Else
                Set a = lv.ListItems.Add(, str, StripExtension(myFile), , 1)
            
                 On Error Resume Next
                 
                 fdate = fso.FileDateTime(str)
                 
                 a.SubItems(1) = FormatDate(fdate)
                 If (Err.Number <> 0) Then
                     MsgBox Err.Description, vbOKOnly
                 End If
           
                 a.SubItems(2) = FormatSize(fso.FileLen(str))
                 If (Err.Number <> 0) Then
                     MsgBox Err.Description, vbOKOnly
                 End If
        
                 a.SubItems(3) = SortableDate(fdate)
                 a.SubItems(4) = 9999999 - fso.FileLen(str)
        
                 On Error GoTo 0
           
            End If
   
            myFile = fso.Dir
   
       Loop

    Next i
End Sub