vb6.0制作浏览器怎样写另存为、打开、添加至收藏夹、整理收藏夹。详细代码是什么？
悬赏分：25 - 解决时间：2008-7-23 05:37
代码要详细一点，相关函数还请大哥讲解一下。
提问者： lqp12345 - 一级最佳答案添加2个txet控件,一个command(实现添加至收藏夹)
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)
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 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\https://www.doczj.com/doc/485171413.html,--中国最大的开发者网络.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
Private Sub Command1_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)
End Sub
Private Sub Form_Load()
End Sub
添加listbox,command,text,webbrowser
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim m As Integer, s As Integer, ms As Integer, flag As Boolean
Dim FPath As String
Private Sub Command1_Click()
Dim WSH As Object
Set WSH = CreateObject("Wscript.Shell")
FPath = WSH.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Favorites")
Set WSH = Nothing
Dim tmp As String
tmp = Dir(FPath & "\*.url")
If Len(tmp) Then List1.Clear
Do While Len(tmp)
List1.AddItem tmp
tmp = Dir
Loop
End Sub
Private Sub Form_Load()
End Sub
Private Sub List1_Click()
Dim URL As String
Open FPath & "\" & List1.Text For Input As #1
URL = Input$(LOF(1), 1)
Close #1
URL = Mid$(URL, InStr(URL, "URL=") + 4)
URL = Left$(URL, InStr(URL, vbCrLf))
Text1.Text = URL
WebBrowser1.Navigate Text1.Text
End Sub