Call the favorites of IE (the system needs IE4 or higher)
The Internet Explorer library --SHDocvw.dll contains many APIs that can manipulate the IE favorites. The two APIs are called the "Add to Favorites" and "Organize Favorites" dialog box. The following sample program is how to use these two dialogs
.
Dialog "Add to Favorites" is very like Saveas Dialog in the General dialog box of Windows, which does not have any functions (you cannot create or save a file). However, he provides a mechanism that creates and saves one
When the Internet is shortcut, you can allow the developer to get information in the "Favorites" required. Because it accepts a PIDL parameter, specify CSIDL_FAVORITES when calling the ShgetSpecialFolderLocation function.
The PIDL description of the user "Favorites" will be returned. Then use it as a member in the API, and what we want "Add to Favorites" dialog box will appear.
The "Solving Favorites" dialog provides us to create functions such as creation folders, rename folders, and delete folders.
Code: New Standard EXE project, add 3 Button (Command1-Command3), 3 Text Text Boxes (Text1-Text3) ............
Option Explicit'''''''''''''''''''''''''''''''''''''''''''''''' '' '' '' '' '' '' '40star Collection and Translate' Contact Address: 40STAR@163.com '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ''Private Const Max_path As Long = 260Private const ERROR_SUCCESS As Long = 0Private const S_OK As Long = 0Private const S_FALSE As Long = 1Private const SHGFP_TYPE_CURRENT As Long = & H0Private const SHGFP_TYPE_DEFAULT As Long = & H1Const 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 LongPrivate Declare Function SHGetFolderPath Lib "shfolder" _ Alias "SHGetFolderPathA" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ ByVal hToken As Long _ Byval dweserved 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 LPFileName As String AS Long Private Declare Sub CotaskMemFree Lib "OLE32" _ (Byval PV As Long)
Private sub flow_load ()
TEXT1.TEXT = "9cbs.net - China's largest developer network provides comprehensive information services and technical services for developers and related companies" text2.text = "http://www.9cbs.net/" Text3. TEXT = "" End Sub
Private Sub Command1_Click () 'call to "Organize Favorites" dialog Dim lpszRootFolder As String Dim success As Long lpszRootFolder = GetFolderPath (CSIDL_FAVORITES) success = DoOrganizeFavDlg (hWnd, lpszRootFolder) End Sub
PRIVATE SUB Command2_Click () Call "Add to Favorites" dialog DIM SZTITLE AS STRING DIM SURL AS STRING DIM SRESULT AS STRING
'Specify the name sztitle = text1.text' after adding to favorites, specifies the url surl = text2.text 'to add the shortcut after adding to the favorites, to open the MakefavouriteEntry function, open the dialog SResult = MakefavouriteEntry (Sztitle, SURL) Text1.text = sztitle text2.text = surl text3.text = SRESultend Sub
Private submmand3_click ()
Unload me End Sub
Private Function MakefavouritEntry (Sztitle As String, SURL As String) AS String
'Variable Definition Dim success As Long Dim pos As Long Dim nSizeOfPath As Long Dim nSizeOfTitle As Long Dim pidl As Long Dim szPath As String' added chr $ (0) character szTitle = szTitle & Chr $ (0) nSizeOfTitle = Len (szTitle) 'Return to the path szpath = space $ (max_path) & chr $ (0) nsizeofpath = len (szpath)' Get the PIDL (POINTER TO ITEM IDENTIFIER LIST) of the user "Favorites" is successfully returned to ERROR_SUCCESS IF ShgetspecialFolderLocation (HWND, _ CSIDL_FAVORITES, _ PIDL) = Error_Success Then 'calls "Add to Favorites" dialog' hwnd = The handle of this window 'szpath = The absolute path of the selected folder, including the file name and the required URL', for example, In my system is C: / documents and settings / 40star / favorites / 9cbs.net - China's largest developer network .url 'sztitle = Title' pIDL = PIDL Description User's favorites Success = doaddtofavdlg HWnd, _ szpath, nsizeofpath, _ sztitle, nsizeoftitle, _ pIDL
'If the path is valid, the title is specified, and the user selects "OK", Success returns 1 if success = 1 Then' Deletes the last CHR $ (0) POS = INSTR (szpath, chr $ (0)) szpath = left SZPATH, POS - 1) POS = INSTR (SZTITLE, CHR $ (0)) Sztitle = Left (Sztitle, POS - 1) 'Display results in text1.text = szpath text2.text = sztitle Call ProfilesaveItem ("InternetshShortcut" , "URL", SURL, SZPATH) 'Return to create a successful path Makefavouritentry = Szpath End if' Clear PIDL Call CotaskMemFree (PIDL) endiff
END FUNCTION
Public Sub ProfilesaveItem (lpsectionname as string, _ lpkeyname as string, _ lpvalue as string, _ inIfile as string)
Call WritePrivateProfileString (LPSECTIONNAME, LPKEYNAME, LPVALUE, INIFILE)
End Sub
Private Function GetFolderPath (csidl as long) AS STRING
Dim sPath As String Dim sTmp As String 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
