Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const SHGFI_TYPENAME As Long = &H400

Private Type SHFILEINFO
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

Private Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

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 Type FILE_PARAMS
   fAttributes As Long
   sFileRoot As String
   sFileNameExt As String
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
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 FileTimeToLocalFileTime Lib "kernel32" _
  (lpFileTime As FILETIME, _
   lpLocalFileTime As FILETIME) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" _
  (lpFileTime As FILETIME, _
   lpSystemTime As SYSTEMTIME) As Long
   
Private Declare Function SystemTimeToVariantTime Lib "oleaut32" _
  (psystime As SYSTEMTIME, _
   pvtime As Double) As Long
   
Private Declare Function StrFormatByteSizeW Lib "shlwapi" _
  (ByVal qdwLow As Long, _
   ByVal qdwHigh As Long, _
   pwszBuf As Any, _
   ByVal cchBuf As Long) As Long

Private Declare Function SHGetFileInfo Lib "shell32" _
   Alias "SHGetFileInfoA" _
  (ByVal pszPath As String, _
   ByVal dwFileAttributes As Long, _
   psfi As SHFILEINFO, _
   ByVal cbSizeFileInfo As Long, _
   ByVal uFlags As Long) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long


Private Sub Form_Load()

   Command1.Caption = "API - Non-recursive"
   Command2.Caption = "FileSystemObject"
   
   With ListView1
      .ColumnHeaders.Add , , "Filename"
      .ColumnHeaders.Add , , "Size"
      .ColumnHeaders.Add , , "Date"
      .ColumnHeaders.Add , , "Type"
      .View = lvwReport
      .Sorted = False
   End With
   
End Sub


Private Sub Command1_Click()

   Dim tstart As Double
   Dim tend As Double
   Dim FP As FILE_PARAMS
   
   ListView1.ListItems.Clear
   Screen.MousePointer = vbHourglass
   
   tstart = GetTickCount()
   
      With FP
         .sFileRoot = "c:\winnt\system32"
         .sFileNameExt = "*.*"
      End With
      
      Call GetFileInformation(FP)
     
   tend = GetTickCount()
   
   Screen.MousePointer = vbNormal
   
   Text1.Text = ListView1.ListItems.Count & " files found"
   Text2.Text = (tend - tstart) / 1000 & " seconds"

End Sub


Private Sub Command2_Click()

   Dim tstart As Single
   Dim tend As Single
   Dim fso As FileSystemObject
   Dim path As String
      
   Set fso = New FileSystemObject
      
   ListView1.ListItems.Clear
   Screen.MousePointer = vbHourglass
   
   tstart = GetTickCount()

      AddFiles fso.GetFolder("c:\winnt\system32")
    
   tend = GetTickCount()
   
   Screen.MousePointer = vbNormal
   
   Text3.Text = ListView1.ListItems.Count & " files found"
   Text4.Text = (tend - tstart) / 1000 & " seconds"

End Sub


Private Function GetFileType(sFileName As String) As String

   Dim shinfo As SHFILEINFO
   
   Call SHGetFileInfo(sFileName, 0&, shinfo, Len(shinfo), SHGFI_TYPENAME)
   GetFileType = shinfo.szTypeName

End Function


Private Function GetFileDate(CT As FILETIME) As String

  Dim ST As SYSTEMTIME
  
  If FileTimeToSystemTime(CT, ST) Then
     GetFileDate = Format$(DateSerial(ST.wYear, ST.wMonth, ST.wDay), "Short Date")
  Else
     GetFileDate = ""
  End If

End Function


Private Sub AddFiles(fn As Folder)

   Dim fi As File
   Dim itmX As ListItem
   Dim lv As ListView
   
   Set lv = ListView1

   With lv
   
      For Each fi In fn.Files

         Set itmX = .ListItems.Add(, , fi.Name)
         itmX.SubItems(1) = fi.Size
         itmX.SubItems(2) = fi.DateLastModified
         itmX.SubItems(3) = fi.Type
      
      Next fi
   End With
      
End Sub


Private Function FileTimeToVBDate(ftFile As FILETIME) As Date

  Dim ftLocal As FILETIME
  Dim st As SYSTEMTIME
  Dim dbl As Double

  Call FileTimeToLocalFileTime(ftFile, ftLocal)
  Call FileTimeToSystemTime(ftLocal, st)
  Call SystemTimeToVariantTime(st, dbl)
  FileTimeToVBDate = dbl

End Function


Private Sub GetFileInformation(FP As FILE_PARAMS)

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim sPath As String
   Dim sRoot As String
   Dim itmX As ListItem
   Dim lv As ListView
   Dim sSize As String
   
   Set lv = ListView1
   
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & FP.sFileNameExt
   
   hFile = FindFirstFile(sPath, WFD)
   
   If hFile <> INVALID_HANDLE_VALUE Then
   
      With lv
   
         Do
         
            If (WFD.dwFileAttributes And vbDirectory) = 0 Then
            
               Set itmX = .ListItems.Add(, , WFD.cFileName)
               
               sSize = Space$(30)
               Call StrFormatByteSizeW(WFD.nFileSizeLow, _
                                       WFD.nFileSizeHigh, _
                                       ByVal StrPtr(sSize), 30)
               itmX.SubItems(1) = sSize
               itmX.SubItems(2) = FileTimeToVBDate(WFD.ftLastWriteTime)
               itmX.SubItems(3) = GetFileType(sRoot & WFD.cFileName)
            
            End If
            
         Loop While FindNextFile(hFile, WFD)
         
      End With
      
      hFile = FindClose(hFile)
      
   End If

End Sub


Private Function QualifyPath(sPath As String) As String

   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function