Private Const vbDot As Long= 46
Private twipsX As Long
Private twipsY As Long

Private Declare Function DrawIcon Lib "user32" _
  (ByVal hdc As Long, _
   ByVal x As Long, _
   ByVal Y As Long, _
   ByVal hIcon As Long) As Long

Private Declare Function ExtractIcon Lib "shell32" _
   Alias "ExtractIconA" _
  (ByVal hInst As Long, _
   ByVal lpszExeFileName As String, _
   ByVal nIconIndex As Long) As Long
   
Private Declare Function DestroyIcon Lib "user32" _
  (ByVal hIcon As Long) As Long


Private Sub Form_Load()

   With Combo1
      .AddItem "*.*"
      .AddItem "*.exe"
      .AddItem "*.dll"
      .AddItem "*.ocx"
      .AddItem "*.ico"
      .ListIndex = 1
   End With
   
   twipsX = Screen.TwipsPerPixelX
   twipsY = Screen.TwipsPerPixelY
   
   With ListView1
      .ColumnHeaders.Add , , "File"
      .ColumnHeaders.Add , , "Icons"
      .ColumnHeaders.Add , , "File Type"
      .ColumnHeaders.Add , , "Full Filename"
      .View = lvwReport
      .FullRowSelect = True  'VB6 only
      .HideSelection = False 'VB6 only
   End With
      
   Text1.Text = LCase$(Environ$("WINDIR") & "\system32")   
   
End Sub


Private Sub Command1_Click()

   Dim FP As FILE_PARAMS
    
   ListView1.ListItems.Clear
   
   With FP
      .sFileRoot = Text1.Text
      .sFileNameExt = Combo1.Text
      .bRecurse = Check1.Value = 1
      .bList = True
   End With
   
   Screen.MousePointer = vbHourglass
   Call SearchForFiles(FP)
   Screen.MousePointer = vbDefault
   
End Sub


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 sTmp As String
   Dim itmx As ListItem
   Dim nIconCount As Long
   
   Dim lv As Control
   Set lv = ListView1
      
  'FP.sFileRoot (assigned to sRoot) contains
  'the path to search.
  '
  'FP.sFileNameExt (assigned to sPath) contains
  'the full path and filespec.
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & FP.sFileNameExt
   
  'obtain handle to the first filespec match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then

      Do
      
        'remove trailing nulls
         sTmp = TrimNull(WFD.cFileName)
         
        'Even though this routine uses filespecs,
        '*.* is still valid and will cause the search
        'to return folders as well as files, so a
        'check against folders is still required.
         If Not (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
            = FILE_ATTRIBUTE_DIRECTORY Then

            nIconCount = GetFileIconCount(sRoot & sTmp)

           'add to the list if the flag indicates
            If FP.bList And nIconCount > 0 Then
                             
              'got the data, so add it to the listview
               Set itmx = lv.ListItems.Add(, , LCase$(sTmp))
               
               itmx.SubItems(1) = nIconCount
               itmx.SubItems(2) = GetFileDescription(sRoot & sTmp)
               itmx.SubItems(3) = LCase$(sRoot & sTmp)
               
            End If
         
         End If
         
      Loop While FindNextFile(hFile, WFD)
      
     'close the handle
      hFile = FindClose(hFile)
   
   End If

End Sub


Public Function TrimNull(startstr As String) As String

  'returns the string up to the first
  'null, if present, or the passed str
   Dim pos As Integer
   
   pos = InStr(startstr, Chr$(0))
   
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
  
   TrimNull = startstr
  
End Function


Private Function QualifyPath(sPath As String) As String

  'assures that a passed path ends in a slash
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function


Private Sub SearchForFiles(FP As FILE_PARAMS)

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
      
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & "*.*"
   
  'obtain handle to the first match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then
   
     'This is where the method obtains the file
     'list and data for the folder passed.

      Call GetFileInformation(FP)

      Do
      
        'if the returned item is a folder...
         If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            
           '..and the Recurse flag was specified
            If FP.bRecurse Then
            
              'remove trailing nulls
               sTmp = TrimNull(WFD.cFileName)
               
              'and if the folder is not the default
              'self and parent folders...
               If Asc(sTmp) <> vbDot Then
               
                 'append new path and search that folder
                  FP.sFileRoot = sRoot & sTmp
                  Call SearchForFiles(FP)
                  
               End If
               
            End If
            
         End If
         
     'continue looping until FindNextFile returns
     '0 (no more matches)
      Loop While FindNextFile(hFile, WFD)
      
     'close the find handle
      hFile = FindClose(hFile)
   
   End If
   
End Sub


Private Sub GetFileIcons(sIconFile As String)

   Dim thisRow As Long
   Dim thisCol As Long
   Dim numIcons As Long
   Dim numRowsNeeded As Long
   Dim rowX As Long
   Dim colX As Long
   Dim cnt As Long
   Dim hIcon As Long
   
  'This needs to be set  - as coded it will display
  '10 items across, regardless whether the viewport
  'will show all 10. In a practical application
  'this value would be calculated based on the 
  'the width of the viewport window, divided by
  'the width of the icon plus any additional padding
  'added to spread them apart on screen.
  '
  'If you see strange results (ie only 2 partial 
  'rows icons when the file contains 20, for example, 
  'tweak this number down to correctly reflect the 
  'number that can comfortably fit the viewport
  'without a horizontal scrollbar. 
   Const maxPerRow As Long = 10
   
   Picture1.Cls
   
  'how many icons in the file?
   numIcons = GetFileIconCount(sIconFile)
   
  'if one or more ...
   If numIcons > 0 Then
   
     'calc the number of rows needed. Note
     'that this is hard-coded for 10 per line.
     'A more precise way of doing this would be
     'to calc the size of the pixbox, the size
     'of an icon, and the inter-icon spacing desired,
     'to dynamically calc the number of icons per row.
      numRowsNeeded = numIcons \ maxPerRow
      
     'avoid error
      If numRowsNeeded = 0 Then numRowsNeeded = 1
      
     'this adds an extra row if numIcons \ 10
     'results in a remainder
      If numRowsNeeded Mod numIcons Then
         numRowsNeeded = numRowsNeeded + 1
      End If
      
     'establish initial positions and size.
      With Picture1
      
         .Left = 0
         .Top = 0
         .Height = (numRowsNeeded * 66) * twipsX
         .Width = Picture2.Width * twipsY
    
         For thisRow = 0 To numRowsNeeded - 1
            For thisCol = 0 To maxPerRow - 1
           
              'this calcs the position within
              'the pixbox to draw the icon
               rowX = (thisCol * 48)
               colX = (thisRow * 60) + 8
            
               If thisCol = 0 Then rowX = rowX + 8
            
                 'get the icon in position
                 'specified by cnt
                  hIcon = ExtractIcon(0&, sIconFile, cnt)
            
                  If hIcon Then
                 
                    'draw the icon
                     Call DrawIcon(Picture1.hdc, rowX, colX, hIcon)

                    'add a number underneath indicating
                    'the icon number in the file
                     .ForeColor = vbBlue
                     .CurrentX = rowX + 2
                     .CurrentY = colX + 33
                  
                    'can't use a With statement against
                    'a Print method!
                     Picture1.Print cnt
                  
                    'we don't need that icon any
                    'longer, so toast it
                     Call DestroyIcon(hIcon)
               
                  End If  'If hIcon
               
               cnt = cnt + 1
            
            Next  'For thisCol
         Next  'For thisRow
      
      End With  'With Picture1
      
   End If  'If numIcons
   
   
  'now that the pixbox contains the icons,
  'set the scrollbar properties to the
  'correct values
   VScroll1.Min = 0
   VScroll1.Value = 0
   VScroll1.Enabled = True
   
   If numRowsNeeded > 5 Then
      VScroll1.Max = numRowsNeeded + (75)
      VScroll1.Enabled = True
   Else
      VScroll1.Max = numRowsNeeded
      VScroll1.Enabled = False
   End If

End Sub


Private Function GetFileIconCount(sIconFile As String) As Long

   GetFileIconCount = ExtractIcon(0&, sIconFile, -1)

End Function


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

   ListView1.SortKey = ColumnHeader.index - 1
   ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)
   ListView1.Sorted = True
   
End Sub


Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

   Call GetFileIcons(Item.SubItems(3))

End Sub


Private Sub VScroll1_Change()

   Picture1.Top = (VScroll1.Value / 100) * (Picture2.ScaleHeight - Picture1.Height)

End Sub


Private Sub VScroll1_Scroll()

   Picture1.Top = (VScroll1.Value / 100) * (Picture2.ScaleHeight - Picture1.Height)

End Sub