exbrowser.vb

VB.NET的Web浏览器IE7的克隆选项卡式浏览器 描述：这是一个例子写的vb.net浏览器使用的。 NET Framework 2.0 （ Visual Studio 2005中） 。这是一个

#Region " Read Me "
'Unfortunatelty the Web Browser control in VS2005 is just a wrapper of IE ActiveX control and not a very
'complete one, some methods were added to make some of the features you would want
'easier to access, but unfortunately to get some features you would want the easy way such as find
'and other dialogs that IE can show, you still have to reference 'SHDocVw' (the ie active x control).
'I decided to find a way to get at this functionality without referencing the SHDocVW.DLL directly in the 
'project and instead import the required features at runtime and then release them.
#End Region

Imports System
Imports System.Text
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Security.Permissions

<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
Public Class exBrowser
    Inherits System.Windows.Forms.WebBrowser

#Region " COM Imports Etc..."
    <StructLayout(LayoutKind.Sequential)> _
Public Structure OLECMDTEXT
        Public cmdtextf As UInt32
        Public cwActual As UInt32
        Public cwBuf As UInt32
        Public rgwz As Char
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure OLECMD
        Public cmdID As Long
        Public cmdf As UInt64
    End Structure
    ' Interop - IOleCommandTarget (See MSDN - http://support.microsoft.com/?kbid=311288)
    <ComImport(), Guid("b722bccb-4e68-101b-a2bc-00aa00404770"), _
    InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
    Public Interface IOleCommandTarget
        Sub QueryStatus(ByRef pguidCmdGroup As Guid, ByVal cCmds As UInt32, _
            <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)> ByVal prgCmds As OLECMD, _
            ByRef pCmdText As OLECMDTEXT)

        Sub Exec(ByRef pguidCmdGroup As Guid, ByVal nCmdId As Long, _
            ByVal nCmdExecOpt As Long, ByRef pvaIn As Object, _
            ByRef pvaOut As Object)
    End Interface

    Private cmdGUID As New Guid(&HED016940, -17061, _
  &H11CF, &HBA, &H4E, &H0, &HC0, &H4F, &HD7, &H8, &H16)


#Region " Commands Enumeration "
    'There are a ton of ole commands, we are only using a couple, msdn research will
    'allow you to figure out which ones you want to use.
    Enum oCommands As Long
        Options
        Find = 1
        ViewSource = 2
        '////////////////////////////////////////
        ID_FILE_SAVEAS = 32771
        ID_FILE_PAGESETUP = 32772
        ID_FILE_IMPORTEXPORT = 32774
        ID_FILE_PRINTPREVIEW = 32776
        ID_FILE_NEWIE = 32779
        ID_FILE_NEWMAIL = 32780
        PID_FILE_NEWINTERNETCALL = 32781
        ID_FILE_ADDTRUST = 32782
        ID_FILE_ADDLOCAL = 32783
        DLCTL_BGSOUNDS = &H40
        DLCTL_DLIMAGES = &H10
        DLCTL_DOWNLOADONLY = &H800
        DLCTL_FORCEOFFLINE = &H10000000
        DLCTL_NO_BEHAVIORS = &H800
        DLCTL_NO_CLIENTPULL = &H20000000
        DLCTL_NO_DLACTIVEXCTLS = &H400
        DLCTL_NO_FRAMEDOWNLOAD = &H1000
        DLCTL_NO_JAVA = &H100
        DLCTL_NO_METACHARSET = &H10000
        DLCTL_NO_RUNACTIVEXCTLS = &H200
        DLCTL_NO_SCRIPTS = &H80
        'DLCTL_OFFLINE DLCTL_OFFLINEIFNOTCONNECTED
        DLCTL_OFFLINEIFNOTCONNECTED = &H80000000
        DLCTL_PRAGMA_NO_CACHE = &H4000
        DLCTL_RESYNCHRONIZE = &H2000
        DLCTL_SILENT = &H40000000
        DLCTL_URL_ENCODING_DISABLE_UTF8 = &H20000
        DLCTL_URL_ENCODING_ENABLE_UTF8 = &H40000
        DLCTL_VIDEOS = &H20
    End Enum

#End Region

#End Region

    'Just a little easier way to get at it.
    Public ReadOnly Property CurrentURL() As String
        Get
            Return Me.Document.Url.ToString
        End Get
    End Property

    Public Sub New()
        MyBase.New()
    End Sub

#Region " Dialogs "

    Public Sub ShowOpen()
        Dim cdlOpen As New OpenFileDialog
        Try
            cdlOpen.Filter = "HTML Files (*.htm)|*.htm|HTML Files (*.html)|*.html|TextFiles" & _
                "(*.txt)|*.txt|Gif Files (*.gif)|*.gif|JPEG Files (*.jpg)|*.jpeg|" & _
                "PNG Files (*.png)|*.png|Art Files (*.art)|*.art|AU Fles (*.au)|*.au|" & _
                "AIFF Files (*.aif|*.aiff|XBM Files (*.xbm)|*.xbm|All Files (*.*)|*.*"

            cdlOpen.Title = " Open File "
            cdlOpen.ShowDialog()

            If cdlOpen.FileName > Nothing Then
                Me.Navigate(cdlOpen.FileName)
            End If
        Catch ex As Exception
            Throw New Exception(ex.Message.ToString)
        End Try
    End Sub

    Public Sub ShowSource()
        Dim cmdt As IOleCommandTarget
        Dim o As Object = Nothing
        Dim oIE As Object = Nothing
        Try
            cmdt = CType(Me.Document.DomDocument, IOleCommandTarget)
            cmdt.Exec(cmdGUID, oCommands.ViewSource, 1, o, o)

        Catch ex As Exception
            Throw New Exception(ex.Message.ToString, ex.InnerException)
        Finally
            cmdt = Nothing
        End Try
    End Sub

    Public Sub ShowFindDialog()
        Dim cmdt As IOleCommandTarget
        Dim o As Object = Nothing
        Dim oIE As Object = Nothing
        Try
            cmdt = CType(Me.Document.DomDocument, IOleCommandTarget)
            cmdt.Exec(cmdGUID, oCommands.Find, 0, o, o)

        Catch ex As Exception
            Throw New Exception(ex.Message.ToString, ex.InnerException)
        Finally
            cmdt = Nothing
        End Try
    End Sub

    Public Sub AddToFavorites(Optional ByVal strURL As String = "", Optional ByVal strTitle As String = "")
        Dim oHelper As Object = Nothing
        Try
            oHelper = New ShellUIHelper
            oHelper.AddFavorite(Me.Document.Url.ToString, Me.DocumentTitle.ToString)
        Catch ex As Exception
            Throw New Exception(ex.Message.ToString)
        End Try
        If oHelper IsNot Nothing AndAlso Marshal.IsComObject(oHelper) Then
            Marshal.ReleaseComObject(oHelper)
        End If
    End Sub

    Public Sub ShowOrganizeFavorites()
        'Organize Favorites
        Dim helper As Object = Nothing
        Try
            helper = New ShellUIHelper()
            helper.ShowBrowserUI("OrganizeFavorites", 0)
        Finally
            If helper IsNot Nothing AndAlso Marshal.IsComObject(helper) Then
                Marshal.ReleaseComObject(helper)
            End If
        End Try
    End Sub

    Public Sub SendToDesktop()
        'Shortcut to desktop
        Dim helper As Object = Nothing
        Try
            helper = New ShellUIHelper()
            helper.AddDesktopComponent(Me.Document.Url.ToString, "website")
        Finally
            If helper IsNot Nothing AndAlso Marshal.IsComObject(helper) Then
                Marshal.ReleaseComObject(helper)
            End If
        End Try
    End Sub

    ''' <summary>
    ''' This Will launch the internet option dialog.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub ShowInternetOptions()
        Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
    End Sub

    Public Sub ShowPrivacyReport()
        Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,2", vbNormalFocus)
    End Sub

#End Region

#Region " Extended "

    <ComImport(), _
        Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"), _
        InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIDispatch), _
        TypeLibType(TypeLibTypeFlags.FHidden)> _
        Public Interface DWebBrowserEvents2