url extraction

How do I extract the url from an entry in the 'favorites' folder, via Visual Basic.

Here's a small Program I wrote a Short While ago for someone who wanted to Backup their Favourites, it demonstrates how to extract the URL from the Shortcut file(s)..

In a Form..

Code:

---

'---------------------------------------------------------------------------
'                            URL Backup Utility
'
'                Written By Aaron Young, October 12th 1999
'
' Should you use this code in whole or part, I would appreciate a mention.
'
'---------------------------------------------------------------------------
'
Option Explicit

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const HKEY_CURRENT_USER = &H80000001

Private Const sBackup = "C:\BackupURLs.txt" 'Backup File & Location

Private Sub cmdBackup_Click()
    Dim sFavPath As String
    Dim lRegKey As Long
    Dim lValue As Long
    'Find the Favorites Folder Location
    If RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", lRegKey) = 0 Then
        'Found Registry Key
        Call RegQueryValueEx(lRegKey, "Favorites", 0&, 0&, 0&, lValue)
        sFavPath = Space(lValue)
        Call RegQueryValueEx(lRegKey, "Favorites", 0&, 1, ByVal sFavPath, lValue)
        sFavPath = Left(sFavPath, Len(sFavPath) - 1)
        Call RegCloseKey(lRegKey)
    End If
    lstURLs.Clear
    lblPath = "Path: " & sFavPath
    lblURLs = "Backing up.."
    If Len(sFavPath) Then
        If Len(Dir(sBackup)) Then Kill sBackup
        Call BackupFavorites(sFavPath, sBackup)
        lblURLs = "URL's: " & lstURLs.ListCount & " Backedup to " & sBackup
    Else
        lblURLs = "Unable to locate Favorites Folder!"
    End If
End Sub

Private Sub BackupFavorites(ByVal sPath As String, ByVal sBackupPath As String)
    Dim sDir As String
    Dim aDirs() As String
    Dim iDirs As Integer
    Dim iFile As Integer
    Dim sURL As String
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sDir = Dir(sPath & "*", vbDirectory)
    While Len(sDir)
        If Left(sDir, 1) <> "." Then
            If (GetAttr(sPath & sDir) And vbDirectory) = vbDirectory Then
                'Save Dir for Recursing Later
                ReDim Preserve aDirs(iDirs)
                aDirs(iDirs) = sPath & sDir
                iDirs = iDirs + 1
            Else
                'Backup the URL
                If Right(LCase(sDir), 4) = ".url" Then
                    iFile = FreeFile
                    Open sPath & sDir For Input As iFile
                    sURL = Input(LOF(iFile), iFile)
                    Close iFile
                    sURL = Mid(sURL, InStr(sURL, "[InternetShortcut]"))
                    sURL = Mid(sURL, InStr(sURL, "URL=") + 4)
                    sURL = Left(sURL, InStr(sURL, vbCrLf) - 1)
                    iFile = FreeFile
                    Open sBackupPath For Append As iFile
                        Print #iFile, sURL
                    Close iFile
                    lstURLs.AddItem Left(sDir, Len(sDir) - 4)
                End If
            End If
        End If
        sDir = Dir
    Wend
    If iDirs Then
        'If there were Sub Dirs, Recurse them.
        For iDirs = 0 To UBound(aDirs)
            Call BackupFavorites(aDirs(iDirs), sBackupPath)
        Next
    End If
End Sub

---

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]