Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB.NET 0401: Popups in eigenem Fenster öffnen

 von 

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Internet und Netzwerke

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
WebBrowser, NewWindow

Der Vorschlag wurde erstellt am: 23.08.2010 17:04.
Die letzte Aktualisierung erfolgte am 24.08.2010 12:58.

Zurück zur Übersicht

Beschreibung  

Wird in der WebBrowser-Komponente auf einen Link geklickt der ein neues Fenster öffnen soll öffnet sich im Normalfall ein InternetExplorer-Fenster.
Um dies unterbinden zu können gibt es das Ereignis NewWindow und den Parameter Cancel in den übergebenen EventArgs.
Leider hat Micosoft das Wichtigste vergessen damit dieses Ereignis wirklich sinnvoll nutzbar ist : die URL für das neue Fenster.
Microsoft hat für dieses Problem einen in C# erstellten Workaround veröffentlicht.
Damit das ganze auch für die unter uns verwendbar ist die C#- nicht in VB-Code übersetzen können, hier nun die Lösung in VB.Net:

Schwierigkeitsgrad

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Download:

Download des Beispielprojektes [14,58 KB] 

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ------- Anfang Projektgruppe ExtendedWebBrowser.sln  -------
' ------ Anfang Projektdatei ExtendedWebBrowser.vbproj  ------
' ------------ Anfang Datei IWebBrowserEvents2.vb ------------
Imports System.Runtime.InteropServices

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

    <DispId(250)> _
        Sub BeforeNavigate2(<[In](), MarshalAs(UnmanagedType.IDispatch)> ByVal pDisp As Object, _
        <InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef URL As String, _
        <InAttribute()> ByRef flags As Object, _
        <InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef targetFrameName As String, _
        <InAttribute()> ByRef postdata As Object, _
        <InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef headers As String, _
        <InAttribute(), OutAttribute()> ByRef cancel As Boolean)

    ' Note: Postdata is a SafeArray but for some reason, if I do a proper declaration, the
    ' event will not be raised:
    ' <[In](), MarshalAs(UnmanagedType.SafeArray, safearraysubtype:=VarEnum.VT_UI1)> ByRef
    ' postdata() As Byte,
    <DispId(273)> _
        Sub NewWindow3(<InAttribute(), MarshalAs(UnmanagedType.IDispatch)> ByVal pDisp As Object, _
        <InAttribute(), OutAttribute()> ByRef cancel As Boolean, _
        <InAttribute()> ByRef Flags As Object, _
        <InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef UrlContext As String, _
        <InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef Url As String)

End Interface

' ------------- Ende Datei IWebBrowserEvents2.vb -------------
' ---------- Anfang Datei NavigatingExEventArgs.vb  ----------
Imports System.ComponentModel

Public Class NavigatingExEventArgs

    Inherits CancelEventArgs

    Private m_Url As String
    Private m_Frame As String
    Private m_Postdata() As Byte
    Private m_Headers As String

    Public ReadOnly Property Url() As String
        Get
            Return m_Url

        End Get

    End Property

    Public ReadOnly Property Frame() As String
        Get
            Return m_Frame

        End Get

    End Property

    Public ReadOnly Property Headers() As String
        Get
            Return m_Headers

        End Get

    End Property

    Public ReadOnly Property Postdata() As String
        Get
            Return PostdataToString(m_Postdata)

        End Get

    End Property

    Public ReadOnly Property PostdataByte() As Byte()
        Get
            Return m_Postdata

        End Get

    End Property

    Public Sub New(ByVal url As String, ByVal frame As String, ByVal postdata As Byte(), _
        ByVal headers As String)

        m_Url = url
        m_Frame = frame
        m_Postdata = postdata
        m_Headers = headers

    End Sub

    Private Function PostdataToString(ByVal p() As Byte) As String

        ' not sexy but it works...
        Dim tabpd() As Byte, bstop As Boolean = False, stmp As String = "", i As Integer = 0

        tabpd = p

        If tabpd Is Nothing OrElse tabpd.Length = 0 Then
            Return ""

        Else

            For i = 0 To tabpd.Length - 1
                stmp += ChrW(tabpd(i))
            Next

            stmp = Replace(stmp, ChrW(13), "")
            stmp = Replace(stmp, ChrW(10), "")
            stmp = Replace(stmp, ChrW(0), "")
        End If

        If stmp = Nothing Then
            Return ""

        Else

            Return stmp
        End If

    End Function

End Class

' ----------- Ende Datei NavigatingExEventArgs.vb  -----------
' ---------- Anfang Datei NewWindowsExEventArgs.vb  ----------
Imports System.ComponentModel

Public Class NewWindowExEventArgs

    Inherits CancelEventArgs

    Private m_Url As String
    Private m_UrlContext As String
    Private m_Flags As NWMF

    Public ReadOnly Property Url() As String
        Get
            Return m_Url

        End Get

    End Property

    Public ReadOnly Property UrlContext() As String
        Get
            Return m_UrlContext

        End Get

    End Property

    Public ReadOnly Property Flags() As NWMF
        Get
            Return m_Flags

        End Get

    End Property

    Public Sub New(ByVal url As String, ByVal urlcontext As String, ByVal flags As NWMF)

        m_Url = url
        m_UrlContext = urlcontext
        m_Flags = flags

    End Sub

End Class

' ----------- Ende Datei NewWindowsExEventArgs.vb  -----------
' --------------- Anfang Datei WebBrowserEx.vb ---------------
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.ComponentModel

Public Enum NWMF
    NWMF_UNLOADING = &H1&
    NWMF_USERINITED = &H2&
    NWMF_FIRST_USERINITED = &H4&
    NWMF_OVERRIDEKEY = &H8&
    NWMF_SHOWHELP = &H10&
    NWMF_HTMLDIALOG = &H20&
    NWMF_FROMPROXY = &H40&
End Enum

Public Class WebBrowserEx

    Inherits WebBrowser

    Private cookie As AxHost.ConnectionPointCookie
    Private wevents As WebBrowserExEvents

    ' This method will be called to give you a chance to create your own event sink
    Protected Overrides Sub CreateSink()

        ' MAKE SURE TO CALL THE BASE or the normal events won't fire
        MyBase.CreateSink()
        wevents = New WebBrowserExEvents(Me)

        cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance, wevents, GetType( _
            IWebBrowserEvents2))

    End Sub

    Protected Overrides Sub DetachSink()

        If Not cookie Is Nothing Then
            cookie.Disconnect()
            cookie = Nothing
        End If

        MyBase.DetachSink()

    End Sub

    ' This new event will fire when the page is navigating
    Public Delegate Sub NavigatingExEventHandler(ByVal sender As Object, ByVal e As _
        NavigatingExEventArgs)

    Public Event NavigatingEx As NavigatingExEventHandler

    ' This event will fire when a new window is about to be opened
    Public Delegate Sub NewWindowExEventHandler(ByVal sender As Object, ByVal e As _
        NewWindowExEventArgs)

    Public Event NewWindowEx As NewWindowExEventHandler

    Protected Friend Sub OnNavigatingEx(ByVal Url As String, ByVal Frame As String, ByVal _
        Postdata As Byte(), ByVal Headers As String, ByRef Cancel As Boolean)

        Dim e As NavigatingExEventArgs = New NavigatingExEventArgs(Url, Frame, Postdata, Headers)

        RaiseEvent NavigatingEx(Me, e)
        Cancel = e.Cancel

    End Sub

    Protected Friend Sub OnNewWindowEx(ByVal Url As String, ByRef Cancel As Boolean, ByVal _
        Flags As NWMF, ByVal UrlContext As String)

        Dim e As NewWindowExEventArgs = New NewWindowExEventArgs(Url, UrlContext, Flags)

        RaiseEvent NewWindowEx(Me, e)
        Cancel = e.Cancel

    End Sub

End Class

' ---------------- Ende Datei WebBrowserEx.vb ----------------
' ------------------ Anfang Datei Form1.vb  ------------------
Public Class Form1

    Private Sub ExtendedWebbrowser1_NewWindowEx(ByVal sender As Object, ByVal e As _
        NewWindowExEventArgs) Handles ExtendedWebBrowser1.NewWindowEx

        Dim frm As New Form1

        frm.ExtendedWebBrowser1.Navigate(e.Url)
        frm.Show()
        e.Cancel = True

    End Sub

    Private Sub txtUrl_KeyUp(ByVal sender As Object, ByVal e As _
        System.Windows.Forms.KeyEventArgs) Handles txtUrl.KeyUp

        If e.KeyCode = Keys.Enter Then
            ExtendedWebBrowser1.Navigate(txtUrl.Text)
        End If

    End Sub

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' ------------ Anfang Datei WebBrowserExEvents.vb ------------
Class WebBrowserExEvents

    Inherits System.Runtime.InteropServices.StandardOleMarshalObject
    Implements IWebBrowserEvents2

    Private m_Browser As WebBrowserEx

    Public Sub New(ByVal browser As WebBrowserEx)

        m_Browser = browser

    End Sub

    Public Sub BeforeNavigate2(ByVal pDisp As Object, ByRef URL As String, ByRef flags As _
        Object, ByRef targetFrameName As String, ByRef postData As Object, ByRef headers As _
        String, ByRef cancel As Boolean) Implements IWebBrowserEvents2.BeforeNavigate2

        m_Browser.OnNavigatingEx(URL, targetFrameName, CType(postData, Byte()), headers, cancel)

    End Sub

    Public Sub NewWindow3(ByVal pDisp As Object, ByRef Cancel As Boolean, ByRef Flags As _
        Object, ByRef UrlContext As String, ByRef Url As String) Implements _
        IWebBrowserEvents2.NewWindow3

        m_Browser.OnNewWindowEx(Url, Cancel, CType(Flags, NWMF), UrlContext)

    End Sub

End Class

' ------------- Ende Datei WebBrowserExEvents.vb -------------
' ------- Ende Projektdatei ExtendedWebBrowser.vbproj  -------
' -------- Ende Projektgruppe ExtendedWebBrowser.sln  --------

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Diskussion zum Vorschlag - AtaRist 23.08.2010 17:21

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.