E
收藏夹(系统需要IE4以上版本)Internet Explorer 库--shdocvw.dll包含了许多可以操纵IE收藏夹
API
其中两个API是
IE“添加到收藏夹”和“整理收藏夹”对话框下面举例
就是如何使用这两个对话框“添加到收藏夹”
Dialog很像Windows通用对话框中SaveAs Dialog
它自身没有任何机能(不能创建或保存
个文件)然而他却提供了种机制当用户创建并保存个
ernet快捷方式时可以让开发人员能够得到需要“收藏夹”中信息
它会接受到个pidl参数当SHGetSpecialFolderLocation
时指定了CSIDL_FAVORITES就会返回用户“收藏夹”
pidl描述再把它用作API中个成员我们想要“添加到收藏夹”对话框就会出现了“整理收藏夹”对话框可以提供我们创建创建文件夹、重命名文件夹和删除文件夹等功能
代码:
新建标准EXE工程
加入3个Button(Command1-Command3)3个Text文本框(Text1-Text3)............Option Explicit
´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´
´40Star收藏并翻译
´联系地址:
´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´´
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 = \"CSDN.NET--中国最大
开发者网络为开发人员和相关企业提供全面信息服务和技术服务\"Text2.Text = \"\"
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
´指定添加到收藏夹后
快捷方式名称szTitle = Text1.Text
´指定添加到收藏夹后
快捷方式URLsURL = Text2.Text
´
MakeFavouriteEntry打开对话框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
´变量定义
Dim success As Long
Dim pos As Long
Dim nSizeOfPath As Long
Dim nSizeOfTitle As Long
Dim pidl As Long
Dim szPath As String
´追加chr$(0)
szTitle = szTitle & Chr$(0)
nSizeOfTitle = Len(szTitle)
´返回路径
串szPath = Space$(MAX_PATH) & Chr$(0)
nSizeOfPath = Len(szPath)
´得到用户“收藏夹”路径
PIDL (poer to item ident
ier list)´成功后返回值为ERROR_SUCCESS
If SHGetSpecialFolderLocation(hWnd, _
CSIDL_FAVORITES, _
pidl) = ERROR_SUCCESS Then
´
“添加到收藏夹”对话框´hwnd = 本窗口
句柄´szPath = 所选择文件夹
绝对路径包括文件名和所需URL´ 例如
在我系统里就是C:\\Documents and Settings\\40Star\\Favorites\\CSDN.NET--中国最大开发者网络.url´szTitle = 标题
´pidl = PIDL 描述用户
收藏夹信息success = DoAddToFavDlg(hWnd, _
szPath, nSizeOfPath, _
szTitle, nSizeOfTitle, _
pidl)
´如果路径有效并指定了标题
而且用户选择了“确定”success 返回 1If success = 1 Then
´删除最后
Chr$(0)pos = InStr(szPath, Chr$(0))
szPath = Left(szPath, pos - 1)
pos = InStr(szTitle, Chr$(0))
szTitle = Left(szTitle, pos - 1)
´在Text中显示结果
Text1.Text = szPath
Text2.Text = szTitle
Call ProfileSaveItem(\"InternetShortcut\", \"URL\", sURL, szPath)
´返回创建成功
路径MakeFavouriteEntry = szPath
End If
´清空PIDL
Call CoTaskMemFree(pidl)
End If
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
最新评论