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

Author:水如烟

 

这里实现把收藏夹中的url快捷方式添加到“收藏夹”菜单栏。

示图：

 

代码：

Imports System.Text

 

Namespace LzmTW.uSystem.uWindows.uForm.Web

    Partial Class WinMenuStrip

 

        Private gUrlMenuItems As New List(Of UrlMenuItem)

 

        Private Sub FavoriteToolStripMenuItem_DropDownOpening(ByVal sender As Object, ByVal e As System.EventArgs) _

        Handles FavoriteToolStripMenuItem.DropDownOpening

            If Me.gWebBrowser Is Nothing Then Return

 

            UrlMenuItemsClear()

            UrlMenuItemsAdd()

        End Sub

 

        Private Sub UrlMenuItemsAdd()

            AddUrlItem(Nothing, System.Environment.GetFolderPath(Environment.SpecialFolder.Favorites))

 

            Me.FavoriteToolStripMenuItem.DropDownItems.AddRange(Me.gUrlMenuItems.ToArray)

        End Sub

 

        Private Sub UrlMenuItemsClear()

 

            For Each item As UrlMenuItem In Me.gUrlMenuItems

                Me.FavoriteToolStripMenuItem.DropDownItems.Remove(item)

                If item.IsUrl Then RemoveHandler item.Click, AddressOf UrlMenuItem_Click

                item.Dispose()

            Next

 

            Me.gUrlMenuItems.Clear()

        End Sub

 

        Private Sub UrlMenuItem_Click(ByVal sender As Object, ByVal e As System.EventArgs)

            Dim url As Object = CType(sender, ToolStripMenuItem).Tag

            If url Is Nothing Then Return

            Me.gWebBrowser.Navigate(url.ToString)

        End Sub

 

        Public Sub AddUrlItem(ByVal parent As ToolStripMenuItem, ByVal path As String)

 

            For Each dire As String In IO.Directory.GetDirectories(path)

                Dim mUrlItem As New UrlItem(dire, False)

                Dim mUrlMenuItem As New UrlMenuItem(mUrlItem)

 

                If parent Is Nothing Then

                    gUrlMenuItems.Add(mUrlMenuItem)

                Else

                    parent.DropDownItems.Add(mUrlMenuItem)

                End If

 

                AddUrlItem(mUrlMenuItem, dire)

            Next

 

 

            For Each file As String In IO.Directory.GetFiles(path, "*.url")

                Dim mUrlItem As New UrlItem(file, True)

                Dim mUrlMenuItem As New UrlMenuItem(mUrlItem)

 

                AddHandler mUrlMenuItem.Click, AddressOf UrlMenuItem_Click

 

                If parent Is Nothing Then

                    gUrlMenuItems.Add(mUrlMenuItem)

                Else

                    parent.DropDownItems.Add(mUrlMenuItem)

                End If

            Next

 

        End Sub

 

        Private Class UrlMenuItem

            Inherits ToolStripMenuItem

            Private gIsUrl As Boolean

 

            Public ReadOnly Property IsUrl() As Boolean

                Get

                    Return gIsUrl

                End Get

            End Property

 

            Sub New(ByVal info As UrlItem)

                With Me

                    .Text = info.Text

                    If info.IsUrl Then

                        .Image = My.Resources.web

                        .Tag = info.Url

                        .ToolTipText = String.Concat(info.Name, vbCrLf, info.Url)

                    Else

                        .Image = My.Resources.folder

                    End If

                End With

            End Sub

        End Class

 

        Private Class UrlItem

            Private gFile As String

            Private gIsUrl As Boolean

            Private gName As String

            Private gText As String

            Private gUrl As String

 

            Sub New(ByVal file As String, ByVal isurl As Boolean)

                gFile = file

                gIsUrl = isurl

                Initialize()

            End Sub

 

            Private Sub Initialize()

                If gIsUrl Then

                    With My.Computer.FileSystem.GetFileInfo(gFile)

                        gName = .Name.Replace(.Extension, "")

                    End With

                    gUrl = Me.GetInternalShortcutUrl(gFile)

                Else

                    gName = My.Computer.FileSystem.GetDirectoryInfo(gFile).Name

                End If

 

                gText = StringTruncate(gName, 68)

            End Sub

 

 

            Public ReadOnly Property File() As String

                Get

                    Return gFile

                End Get

            End Property

 

            Public ReadOnly Property Url() As String

                Get

                    Return gUrl

                End Get

            End Property

 

            Public ReadOnly Property Name() As String

                Get

                    Return gName

                End Get

            End Property

 

            Public ReadOnly Property Text() As String

                Get

                    Return gText

                End Get

            End Property

 

            Public ReadOnly Property IsUrl() As Boolean

                Get

                    Return gIsUrl

                End Get

            End Property

 

            Private Declare Function GetPrivateProfileStringA Lib "kernel32.dll" ( _

                 ByVal lpApplicationName As String, _

                 ByVal lpKeyName As String, _

                 ByVal lpDefault As String, _

                 ByVal lpReturnedString As System.Text.StringBuilder, _

                 ByVal nSize As Integer, _

                 ByVal lpFileName As String _

            ) As Integer

 

            Private Function GetInternalShortcutUrl(ByVal filename As String) As String

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

                GetPrivateProfileStringA("InternetShortcut", "URL", "", mResult, mResult.Capacity, filename)

                Return mResult.ToString

            End Function

 

            Private Function StringTruncate( _

                ByVal input As String, _

                ByVal maxLen As Integer, _

                Optional ByVal suffix As String = "..." _

            ) As String

                Dim s As String = input

                Dim bytes As Byte() = Encoding.Default.GetBytes(s)

                If bytes.Length > maxLen Then

                    s = Encoding.Default.GetString(bytes, 0, maxLen - 1) & suffix

                End If

                Return s

            End Function

        End Class

    End Class

End Namespace

现在做成这模样: