Visual Basic Browse/ PIDL / CSIDL Routines

DoAddToFavDlg: Add and Manipulate IE Favourite Links
     
Posted:   Wednesday November 9, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   IE4 or greater
Author:   VBnet - Randy Birch
     

Related:  

DoAddToFavDlg: Create and Manipulate IE Favourites in Specified Folders
       
 Prerequisites
IE4 or greater.

The Internet Explorer library, shdocvw.dll, contains many APIs that can be used to manipulate the Favourites folders and its items.  Two of the APIs provide the ability to display the Add To Favourites dialog, and the Organize Favourites dialog. This project makes use of these two dialogs to add a URL to the folder specified.

The Add to Favourites dialog behaves exactly like the Windows Common File Save As dialog, that is, it performs no action itself (it does not create or save a file), other that provide the mechanism the developer can use to obtain the requisite Favourite information from a user when creating and saving an internet shortcut. Because it accepts a pidl as one of the parameters, a call to SHGetSpecialFolderLocation specifying CSIDL_FAVORITES returns the pidl representing the user's Favourites folder. By passing that as the APIs pidl member, the dialog appears rooted within the Favourites folder.

The Organize Favourites dialog provides the ability to reorganize the Favourites items, including creating new folders, renaming and deleting.

 BAS Module Code
None.

 Form Code
To a project form add three command buttons (Command1-Command3), three text boxes (Text1-Text3), and label as desired. Add the following to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const ERROR_SUCCESS As Long = 0
Private Const S_OK As Long = 0
Private Const S_FALSE As Long = 1
Private Const SHGFP_TYPE_CURRENT As Long = &H0
Private Const SHGFP_TYPE_DEFAULT As Long = &H1
Const CSIDL_FAVORITES As Long = &H6

Private Declare Function DoAddToFavDlg Lib "shdocvw" _
  (ByVal hWnd As Long, _
   ByVal szPath As String, _
   ByVal nSizeOfPath As Long, _
   ByVal szTitle As String, _
   ByVal nSizeOfTitle As Long, _
   ByVal pidl As Long) As Long
   
Private Declare Function DoOrganizeFavDlg Lib "shdocvw" _
  (ByVal hWnd As Long, _
   ByVal lpszRootFolder As String) As Long

Private Declare Function SHGetFolderPath Lib "shfolder" _
   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 SHGetSpecialFolderLocation Lib "shell32" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
   pidl As Long) As Long
   
Private Declare Function WritePrivateProfileString Lib "kernel32"
   Alias "WritePrivateProfileStringA" _
  (ByVal lpSectionName As String, _
   ByVal lpKeyName As Any, _
   ByVal lpString As Any, _
   ByVal lpFileName As String) As Long
   
Private Declare Sub CoTaskMemFree Lib "ole32" _
   (ByVal pv As Long)



Private Sub Form_Load()

   Text1.Text = "VBnet - The Dev Resource Centre"
   Text2.Text = "http://vbnet.mvps.org/"
   Text3.Text = ""
   
End Sub

Private Sub Command1_Click()

  Dim lpszRootFolder As String
  Dim success As Long
  
   lpszRootFolder = GetFolderPath(CSIDL_FAVORITES)
   success = DoOrganizeFavDlg(hWnd, lpszRootFolder)
   
End Sub


Private Sub Command2_Click()

   Dim szTitle As String
   Dim sURL As String
   Dim sResult As String

  'assign a title to the url. This is the
  'name that appears under Favourites
   szTitle = Text1.Text
   
  'assign the url. This is the
  'value saved to the Favourite file.
   sURL = Text2.Text
   
  'call the Make routine, returning the
  'file created as a success
   sResult = MakeFavouriteEntry(szTitle, sURL)
   
   Text1.Text = szTitle
   Text2.Text = sURL
   Text3.Text = sResult

End Sub


Private Sub Command3_Click()

   Unload Me
   
End Sub


Private Function MakeFavouriteEntry(szTitle As String, 
                                    sURL As String) As String

  'working variables
   Dim success As Long
   Dim pos As Long
   Dim nSizeOfPath As Long
   Dim nSizeOfTitle As Long
   Dim pidl As Long
   Dim szPath As String
  
  'set up the szTitle size, appending a chr$(0)
   szTitle = szTitle & Chr$(0)
   nSizeOfTitle = Len(szTitle)
   
  'pad a string for the return path
   szPath = Space$(MAX_PATH) & Chr$(0)
   nSizeOfPath = Len(szPath)
   
  'get the PIDL (pointer to item identifier list)
  'of the user's Favourites path.
  'If successful, the return value is ERROR_SUCCESS
   If SHGetSpecialFolderLocation(hWnd, _
                                 CSIDL_FAVORITES, _
                                 pidl) = ERROR_SUCCESS Then
        
     'call the Add to Favourites dialog.
     'hwnd   =  the owner of the dialog, in this case our form.
     'szPath =  the absolute path returned to the selected folder,
     '          including the full file name appended, and the
     '          requisite .url extension. For example, on my system,
     '          using the Title specified above, and saving the file
     '          to the root Favourites folder, the szPath returned is:
     '          C:\WINNT\Profiles\birchr\Favorites\VBnet Res Centre.url
     'szTitle = the title (Favourite name) for the URL
     'pidl    = the PIDL representing the user's Favourites folder
      success = DoAddToFavDlg(hWnd, _
                              szPath, nSizeOfPath, _
                              szTitle, nSizeOfTitle, _
                              pidl)

     'if a valid file path and title was specified,
     'and the user pressed OK, success will = 1
      If success = 1 Then
      
        'remove trailing nulls
         pos = InStr(szPath, Chr$(0))
         szPath = Left(szPath, pos - 1)
         
         pos = InStr(szTitle, Chr$(0))
         szTitle = Left(szTitle, pos - 1)
      
        'show the results in the text boxes
         Text1.Text = szPath
         Text2.Text = szTitle
      
        'a little tom-foolery. Since a favourite link
        'is nothing more than an ini file entry, we can
        'use the WritePrivateProfileString API to create
        'the Favourite entry! The 'ini file name' will
        'be the szPath returned value from the
        'DoAddToFavDlg call, and the value saved to
        'the file will be the URL passed to this procedure
         Call ProfileSaveItem("InternetShortcut", "URL", sURL, szPath)
         
        'return the path/file created as a measure of success
         MakeFavouriteEntry = szPath
      
      End If
      
     'clean up by freeing the PIDL
      Call CoTaskMemFree(pidl)

   End If

End Function


Public Sub ProfileSaveItem(lpSectionName As String, _
                           lpKeyName As String, _
                           lpValue As String, _
                           iniFile As String)

  'This function saves the passed value to the file,
  'under the section and key name specified.
  'If the ini file does not exist, it is created.
  'If the section does not exist, it is created.
  'If the key name does not exist, it is created.
  'If the key name exists, its value is replaced.
   
   Call WritePrivateProfileString(lpSectionName, lpKeyName, lpValue, iniFile)

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_PATH)
   
   If SHGetFolderPath(Me.hWnd, _
                      CSIDL, _
                      0&, _
                      SHGFP_TYPE_CURRENT, _
                      sPath) = S_OK Then
                      
       GetFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
   End If
      
End Function
 Comments
Set the values of Text1 and Text2 as desired, then click the Add To Favourites button. Navigate and edit as desired, and on closing, the URL will be saved into the folder / filename selected. Use the Organize button to delete the file if desired.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter