|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Browse/ PIDL / CSIDL Routines DoAddToFavDlg: Create and Manipulate IE Favourites in Specified Folders |
|
Posted: | Saturday May 17, 1997 |
Updated: | Monday December 26, 2011 |
Applies to: | VB4-32, VB5, VB6 |
Developed with: | VB4-32, Windows 95 |
OS restrictions: | None |
Author: | VBnet - Randy Birch |
Related: |
DoAddToFavDlg: Add and Manipulate IE Favourite Links |
Prerequisites |
IE4 or greater. |
|
This
demo builds on the DoAddToFavDlg and DoOrganizeFavDlg APIs adding the ability to create the internet shortcut in other system folders.
As with the related project, the SHGetSpecialFolderLocation is again used, but this time the combo box is loaded with the values that refer to other system components, such as the desktop or start menu. And just like the other demo, this passes the pidl relating to the specified CSIDL and creates the Favourite in the selected folder. |
BAS Module Code |
None. |
|
Form Code |
To a project form add three command buttons (Command1-Command3), four text boxes (Text1-Text4), a combo box (Combo1) and labels 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 'current value for user, verify it exists Private Const SHGFP_TYPE_DEFAULT As Long = &H1 Private Const CSIDL_PROGRAMS As Long = &H2 'Start Menu\Programs Private Const CSIDL_PERSONAL As Long = &H5 'My Documents Private Const CSIDL_FAVORITES As Long = &H6 '{user name}\Favourites Private Const CSIDL_STARTUP As Long = &H7 'Start Menu\Programs\Startup Private Const CSIDL_STARTMENU As Long = &HB '{user name}\Start Menu Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10 '{user name}\Desktop Private Const CSIDL_TEMPLATES As Long = &H15 Private Const CSIDL_COMMON_STARTMENU As Long = &H16 'All Users\Start Menu Private Const CSIDL_COMMON_PROGRAMS As Long = &H17 'All Users\Programs Private Const CSIDL_COMMON_STARTUP As Long = &H18 'All Users\Startup Private Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19'All Users\Desktop 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 Developers Resource Centre" Text2.Text = "http://vbnet.mvps.org/" Text3.Text = "" Text4.Text = "" With Combo1 .AddItem "CSIDL_PROGRAMS" .ItemData(.NewIndex) = &H2 .AddItem "CSIDL_PERSONAL" .ItemData(.NewIndex) = &H5 .AddItem "CSIDL_FAVORITES" .ItemData(.NewIndex) = &H6 .AddItem "CSIDL_STARTUP" .ItemData(.NewIndex) = &H7 .AddItem "CSIDL_STARTMENU" .ItemData(.NewIndex) = &HB .AddItem "CSIDL_DESKTOPDIRECTORY" .ItemData(.NewIndex) = &H10 .AddItem "CSIDL_TEMPLATES" .ItemData(.NewIndex) = &H15 .AddItem "CSIDL_COMMON_STARTMENU" .ItemData(.NewIndex) = &H16 .AddItem "CSIDL_COMMON_PROGRAMS" .ItemData(.NewIndex) = &H17 .AddItem "CSIDL_COMMON_STARTUP" .ItemData(.NewIndex) = &H18 .AddItem "CSIDL_COMMON_DESKTOPDIRECTORY" .ItemData(.NewIndex) = &H19 .AddItem "CSIDL_APPDATA" .ItemData(.NewIndex) = &H1A .AddItem "CSIDL_COMMON_FAVORITES" .ItemData(.NewIndex) = &H1F .AddItem "CSIDL_COMMON_APPDATA" .ItemData(.NewIndex) = &H23 .ListIndex = 2 'default to Favourites End With End Sub Private Sub Command1_Click() Dim szTitle As String Dim sURL As String Dim sResult As String Dim CSIDL As Long '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 'get the CSIDL value representing the 'root folder selected in the combo CSIDL = Combo1.ItemData(Combo1.ListIndex) 'call the Make routine, returning the 'file created as a success sResult = MakeFavouriteEntrySpecial(szTitle, sURL, CSIDL) Text1.Text = szTitle Text2.Text = sURL Text3.Text = sResult Text4.Text = CSIDL End Sub Private Sub Command2_Click() Dim lpszRootFolder As String Dim success As Long Dim CSIDL As Long 'open the organize folder at the path specified by the CSIDL CSIDL = Combo1.ItemData(Combo1.ListIndex) lpszRootFolder = GetFolderPath(CSIDL) success = DoOrganizeFavDlg(hWnd, lpszRootFolder) End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub Combo1_Click() Text4.Text = Combo1.ItemData(Combo1.ListIndex) Text3.Text = "" End Sub Private Function MakeFavouriteEntrySpecial(szTitle As String, _ sURL As String, _ CSIDL As Long) As String 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 success = SHGetSpecialFolderLocation(hWnd, CSIDL, pidl) 'if the call is successful, the return value is 0 If success = 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 MakeFavouriteEntrySpecial = szPath End If 'clean up by freeing the PIDL Call CoTaskMemFree(pidl) End If End Function Private 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, select a target path from the combo box, then click the Add To Favourites button. The dialog will appear with the selected path rooted (navigation outside the folder is not possible). Navigate and edit as desired, and on closing, the URL will be saved into the folder / filename selected. By changing the CSIDL value, the Organize button will open at the folder specified in the combo box, allowing all the usual dialog options such as creating new folders, deleting, renaming or moving files. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |