分享
 
 
 

调用IE的收藏夹

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

调用IE的收藏夹(系统需要IE4以上版本)

Internet Explorer 库--shdocvw.dll包含了许多可以操纵IE收藏夹的API。其中的两个API是调用IE的“添加到收藏夹”和“整理收藏夹”对话框。下面的示例程序就是如何使用这两个对话框

“添加到收藏夹”的Dialog很像Windows的通用对话框中的SaveAs Dialog,它自身没有任何机能(不能创建或保存一个文件)。然而他却提供了一种机制,当用户创建并保存一个

internet的快捷方式时,可以让开发人员能够得到需要的“收藏夹”中的信息。因为它会接受到一个pidl参数,当调用SHGetSpecialFolderLocation函数时指定了CSIDL_FAVORITES,

就会返回用户“收藏夹”的pidl描述。再把它用作API中的一个成员,我们想要的“添加到收藏夹”对话框就会出现了。

“整理收藏夹”对话框可以提供我们创建创建文件夹、重命名文件夹和删除文件夹等功能。

代码:

新建标准EXE工程,加入3个Button(Command1-Command3),3个Text文本框(Text1-Text3)............

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'40Star收藏并翻译

'联系地址:40Star@163.com

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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 = "http://www.CSDN.net/"

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

'指定添加到收藏夹后的快捷方式的URL

sURL = 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 (pointer to item identifier 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 返回 1

If 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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有