WebBrower的应用和功能扩展(九)

Author:水如烟

 

这里实现“添加到收藏夹”菜单的功能。

利用的是

    Private Declare Function DoAddToFavDlg Lib "shdocvw" ( _

        ByVal hWnd As IntPtr, _

        ByVal szPath As String, _

        ByVal nSizeOfPath As Integer, _

        ByVal szTitle As String, _

        ByVal nSizeOfTitle As Integer, _

        ByVal pidl As IntPtr _

) As Integer

跟上面“整理收藏夹”的对话框有些区别，它仅适用于系统特殊的文件夹，当然不仅仅只适用于收藏夹。再有就是，就算选中单击了“确定”，它什么都没做。

Public Class AddToSpecialFolderDialog

    Private Sub New()

    End Sub

 

    Private Declare Function DoAddToFavDlg Lib "shdocvw" ( _

        ByVal hWnd As IntPtr, _

        ByVal szPath As String, _

        ByVal nSizeOfPath As Integer, _

        ByVal szTitle As String, _

        ByVal nSizeOfTitle As Integer, _

        ByVal pidl As IntPtr _

    ) As Integer

 

    Private Declare Function SHGetSpecialFolderLocation Lib "shell32" ( _

       ByVal hwndOwner As IntPtr, _

       ByVal nFolder As Integer, _

       ByRef pidl As IntPtr _

    ) As Integer

 

    Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv_Renamed As IntPtr)

 

 

    Public Shared Sub Show(ByVal hWnd As IntPtr, ByVal specialfolder As System.Environment.SpecialFolder)

        Dim csidl As Integer = specialfolder

        Dim pidl As IntPtr = IntPtr.Zero

 

        If SHGetSpecialFolderLocation(hWnd, csidl, pidl) = 0 Then

 

            Dim path As String = Space(260) & vbNullChar

            Dim title As String = "Test" & vbNullChar

 

            If DoAddToFavDlg(hWnd, path, path.Length, title, title.Length, pidl) = 1 Then

                Console.WriteLine("True")

            End If

        End If

 

        CoTaskMemFree(pidl)

    End Sub

End Class

 

添加网页快捷方式的方法：

Public Class AddInternetShortcut

    Private Sub New()

    End Sub

 

    Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" ( _

        ByVal lpSectionName As String, _

        ByVal lpKeyName As String, _

        ByVal lpString As String, _

        ByVal lpFileName As String _

    ) As Boolean

 

    Public Shared Function Add(ByVal url As String, ByVal filename As String) As Boolean

        filename = filename.Trim

        If filename.ToLower.LastIndexOf(".url") = -1 Then filename &= ".url"

        Return WritePrivateProfileString("InternetShortcut", "URL", url, filename)

    End Function

 

    Public Shared Function Add(ByVal url As String, ByVal path As String, ByVal name As String) As Boolean

        Dim mFilename As String = My.Computer.FileSystem.CombinePath(path, name)

        Return Add(url, mFilename)

    End Function

 

    Public Shared Function Add(ByVal url As String, ByVal specialfolder As System.Environment.SpecialFolder, ByVal name As String) As Boolean

        Dim mPath As String = System.Environment.GetFolderPath(specialfolder)

        Return Add(url, mPath, name)

    End Function

 

End Class

 

上面两个结合起来，做成添加网页快捷方式到特殊文件夹的类：

Public Class AddInternetShortcutToSpecialFolderDialog

    Private Sub New()

    End Sub

 

    Private Declare Function DoAddToFavDlg Lib "shdocvw" ( _

        ByVal hWnd As IntPtr, _

        ByVal szPath As System.Text.StringBuilder, _

        ByVal nSizeOfPath As Integer, _

        ByVal szTitle As System.Text.StringBuilder, _

        ByVal nSizeOfTitle As Integer, _

        ByVal pidl As IntPtr _

    ) As Integer

 

    Private Declare Function SHGetSpecialFolderLocation Lib "shell32" ( _

       ByVal hwndOwner As IntPtr, _

       ByVal nFolder As Integer, _

       ByRef pidl As IntPtr _

    ) As Integer

 

    Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv_Renamed As IntPtr)

 

 

    Public Shared Sub Show(ByVal hWnd As IntPtr, ByVal specialfolder As System.Environment.SpecialFolder, ByVal url As String, ByVal title As String)

        Dim csidl As Integer = specialfolder

        Dim pidl As IntPtr = IntPtr.Zero

 

        If SHGetSpecialFolderLocation(hWnd, csidl, pidl) = 0 Then

 

            Dim mPath As New System.Text.StringBuilder(" ", 260)

            Dim mTitle As New System.Text.StringBuilder(title)

 

            If DoAddToFavDlg(hWnd, mPath, mPath.Capacity, mTitle, mTitle.Capacity, pidl) = 1 Then

 

                AddInternetShortcut.Add(url, mPath.ToString)

 

            End If

        End If

 

        CoTaskMemFree(pidl)

    End Sub

End Class

 示图:

这样，整理和添加收藏夹的代码就是：

Namespace LzmTW.uSystem.uWindows.uForm.Web

    Partial Class WebBrowser

 

        Public Sub ShowOrganizeFavoriteDialog()

            OrganizeFolderDialog.Show(Me.FindForm.Handle, Environment.SpecialFolder.Favorites)

        End Sub

 

        Public Sub ShowAddToFavoriteDialog()

            AddInternetShortcutToSpecialFolderDialog.Show(Me.FindForm.Handle, Environment.SpecialFolder.Favorites, Me.Url.AbsoluteUri, Me.DocumentTitle)

        End Sub