Results 1 to 2 of 2

Thread: url extraction

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jan 1999
    Location
    UK
    Posts
    26

    Post

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

  2. #2
    Guru Aaron Young's Avatar
    Join Date
    Jun 1999
    Location
    Red Wing, MN, USA
    Posts
    2,176

    Post

    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
    aarony@redwingsoftware.com
    adyoung@win.bright.net

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width