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 SHGFP_TYPE_CURRENT As Long = &H0
Private Const SHGFP_TYPE_DEFAULT As Long = &H1
Private Const CSIDL_FAVORITES As Long = &H6
Private Const CSIDL_COMMON_FAVORITES As Long = &H1F
Private Const MAX_LENGTH As Long = 260
Private Const S_OK As Long = 0
Private Const S_FALSE As Long = 1

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

'this is my type for passing and
'retrieving file search information
Private Type FILE_PARAMS
   bRecurse As Boolean
   bList As Boolean
   bFound As Boolean
   sFileRoot As String
   sFileNameExt As String
   sResult As String
   nFileCount As Long
   nFileSize As Double
End Type

Private Declare Function GetPrivateProfileString _
   Lib "kernel32" Alias "GetPrivateProfileStringA" _
  (ByVal lpSectionName As String, _
   ByVal lpKeyName As Any, _
   ByVal lpDefault As String, _
   ByVal lpReturnedString As String, _
   ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
   
Private Declare Function SHGetFolderPath Lib "shfolder.dll" _
    Alias "SHGetFolderPathA" _
   (ByVal hwndOwner As Long, _
     ByVal nFolder As Long, _
     ByVal hToken As Long, _
     ByVal dwReserved As Long, _
     ByVal lpszPath As String) 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 FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
  
  
  
Private Sub Form_Load()

   With ListView1
   
      .ColumnHeaders.Add 1, , "Link Name"
      .ColumnHeaders(1).Width = (ListView1.Width \ 2) - 200
      
      .ColumnHeaders.Add 2, , "URL"
      .ColumnHeaders(2).Width = (ListView1.Width \ 2) - 200
   
      .View = lvwReport
      
   End With
   
End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'toggle the sort order based on the column clicked
   ListView1.SortKey = ColumnHeader.Index - 1
   ListView1.SortOrder = Abs(ListView1.SortOrder = 0)
   ListView1.Sorted = True
   
End Sub


Private Function SearchForFiles(FP As FILE_PARAMS) As Double

  'local working variables
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim nSize 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 sTmp <> "." And sTmp <> ".." Then
               
                 '..then the item is a real folder, which
                 'may contain other sub folders, so assign
                 'the new folder name to FP.sFileRoot and
                 'recursively call this function again with
                 'the amended information.
                  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 Function


Private Function TrimNull(startstr As String) As String

  'returns the string up to the first
  'null, if present, or the passed string
   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 GetFileInformation(FP As FILE_PARAMS) As Long

  'local working variables
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim pos As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
   Dim sURL As String
   Dim sShortcut As String
   Dim itmX As ListItem
      
  '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
           
           'determine the link name by removing
           'the .url extension
            pos = InStr(sTmp, ".url")
            
            If pos > 0 Then
            
               sShortcut = Left$(sTmp, pos - 1)
           
              'extract the URL
               sURL = ProfileGetItem("InternetShortcut", "URL", "", sRoot & sTmp)
            
              'add to the listview
               Set itmX = ListView1.ListItems.Add(, , sShortcut)
               itmX.SubItems(1) = sURL
         
            End If
            
         End If
         
      Loop While FindNextFile(hFile, WFD)
      
     'close the handle
      hFile = FindClose(hFile)
   
   End If
   
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 Command1_Click()

   Dim FP As FILE_PARAMS
   Dim favPath As String
   
  'retrieve the special folder path
  'to the internet Favourites
   favPath = GetFolderPath(CSIDL_FAVORITES)
   
   If Len(favPath) > 0 Then
   
     'set up the search UDT
      With FP
         .sFileRoot = favPath
         .sFileNameExt = "*.url"
         .bRecurse = True
      End With
      
     'get the files
      Call SearchForFiles(FP)

   End If
   
End Sub


Private Function GetFolderPath(CSIDL As Long) As String

   Dim sPath As String
   Dim sTmp As String
  
  'fill pidl with the specified folder item
   sPath = Space$(MAX_LENGTH)
   
   If SHGetFolderPath(Me.hWnd, CSIDL, 0&, SHGFP_TYPE_CURRENT, sPath) = S_OK Then
       sTmp = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
   End If
   
   GetFolderPath = sTmp
   
End Function


Private Function ProfileGetItem(lpSectionName As String, _
                                lpKeyName As String, _
                                defaultValue As String, _
                                inifile As String) As String

  'Retrieves a value from an ini file corresponding
  'to the section and key name passed.
   Dim success As Long
   Dim nSize As Long
   Dim ret As String
  
  'call the API with the parameters passed.
  'The return value is the length of the string
  'in ret, including the terminating null. If a
  'default value was passed, and the section or
  'key name are not in the file, that value is
  'returned. If no default value was passed (""),
  'then success will = 0 if not found.

  'Pad a string large enough to hold the data.
   ret = Space$(2048)
   nSize = Len(ret)
   success = GetPrivateProfileString(lpSectionName, lpKeyName, _
                                     defaultValue, ret, nSize, inifile)
   
   If success Then
      ProfileGetItem = Left$(ret, success)
   End If
   
End Function