Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>Edit:</p> <p>Slution:</p> <p>eWebbrowser.vb :</p> <pre><code>Imports System Imports System.Text Imports System.Windows.Forms Imports System.ComponentModel Imports System.Collections.Generic Imports System.Runtime.InteropServices Imports System.Security.Permissions &lt;PermissionSet(SecurityAction.Demand, Name:="FullTrust")&gt; _ &lt;System.Runtime.InteropServices.ComVisibleAttribute(True)&gt; _ Public Class eWebbrowser Inherits System.Windows.Forms.WebBrowser #Region " COM Imports Etc..." &lt;StructLayout(LayoutKind.Sequential)&gt; _ Public Structure OLECMDTEXT Public cmdtextf As UInt32 Public cwActual As UInt32 Public cwBuf As UInt32 Public rgwz As Char End Structure &lt;StructLayout(LayoutKind.Sequential)&gt; _ Public Structure OLECMD Public cmdID As Long Public cmdf As UInt64 End Structure ' Interop - IOleCommandTarget (See MSDN - http://support.microsoft.com/?kbid=311288) &lt;ComImport(), Guid("b722bccb-4e68-101b-a2bc-00aa00404770"), _ InterfaceType(ComInterfaceType.InterfaceIsIUnknown)&gt; _ Public Interface IOleCommandTarget Sub QueryStatus(ByRef pguidCmdGroup As Guid, ByVal cCmds As UInt32, _ &lt;MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)&gt; 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(&amp;HED016940, -17061, _ &amp;H11CF, &amp;HBA, &amp;H4E, &amp;H0, &amp;HC0, &amp;H4F, &amp;HD7, &amp;H8, &amp;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 = &amp;H40 DLCTL_DLIMAGES = &amp;H10 DLCTL_DOWNLOADONLY = &amp;H800 DLCTL_FORCEOFFLINE = &amp;H10000000 DLCTL_NO_BEHAVIORS = &amp;H800 DLCTL_NO_CLIENTPULL = &amp;H20000000 DLCTL_NO_DLACTIVEXCTLS = &amp;H400 DLCTL_NO_FRAMEDOWNLOAD = &amp;H1000 DLCTL_NO_JAVA = &amp;H100 DLCTL_NO_METACHARSET = &amp;H10000 DLCTL_NO_RUNACTIVEXCTLS = &amp;H200 DLCTL_NO_SCRIPTS = &amp;H80 'DLCTL_OFFLINE DLCTL_OFFLINEIFNOTCONNECTED DLCTL_OFFLINEIFNOTCONNECTED = &amp;H80000000 DLCTL_PRAGMA_NO_CACHE = &amp;H4000 DLCTL_RESYNCHRONIZE = &amp;H2000 DLCTL_SILENT = &amp;H40000000 DLCTL_URL_ENCODING_DISABLE_UTF8 = &amp;H20000 DLCTL_URL_ENCODING_ENABLE_UTF8 = &amp;H40000 DLCTL_VIDEOS = &amp;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" &amp; _ "(*.txt)|*.txt|Gif Files (*.gif)|*.gif|JPEG Files (*.jpg)|*.jpeg|" &amp; _ "PNG Files (*.png)|*.png|Art Files (*.art)|*.art|AU Fles (*.au)|*.au|" &amp; _ "AIFF Files (*.aif|*.aiff|XBM Files (*.xbm)|*.xbm|All Files (*.*)|*.*" cdlOpen.Title = " Open File " cdlOpen.ShowDialog() If cdlOpen.FileName &gt; 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 ''' &lt;summary&gt; ''' This Will launch the internet option dialog. ''' &lt;/summary&gt; ''' &lt;remarks&gt;&lt;/remarks&gt; 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 " &lt;ComImport(), _ Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"), _ InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIDispatch), _ TypeLibType(TypeLibTypeFlags.FHidden)&gt; _ Public Interface DWebBrowserEvents2 &lt;DispId(250)&gt; _ Sub BeforeNavigate2(&lt;[In](), MarshalAs(UnmanagedType.IDispatch)&gt; ByVal pDisp As Object, _ &lt;InAttribute(), MarshalAs(UnmanagedType.BStr)&gt; ByRef URL As String, _ &lt;InAttribute()&gt; ByRef flags As Object, _ &lt;InAttribute(), MarshalAs(UnmanagedType.BStr)&gt; ByRef targetFrameName As String, _ &lt;InAttribute()&gt; ByRef postdata As Object, _ &lt;InAttribute(), MarshalAs(UnmanagedType.BStr)&gt; ByRef headers As String, _ &lt;InAttribute(), OutAttribute()&gt; 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: '&lt;[In](), MarshalAs(UnmanagedType.SafeArray, safearraysubtype:=VarEnum.VT_UI1)&gt; ByRef postdata() As Byte, _ &lt;DispId(273)&gt; _ Sub NewWindow3(&lt;InAttribute(), MarshalAs(UnmanagedType.IDispatch)&gt; ByVal pDisp As Object, _ &lt;InAttribute(), OutAttribute()&gt; ByRef cancel As Boolean, _ &lt;InAttribute()&gt; ByRef Flags As Object, _ &lt;InAttribute(), MarshalAs(UnmanagedType.BStr)&gt; ByRef UrlContext As String, _ &lt;InAttribute(), MarshalAs(UnmanagedType.BStr)&gt; ByRef Url As String) End Interface Public Enum NWMF NWMF_UNLOADING = &amp;H1&amp; NWMF_USERINITED = &amp;H2&amp; NWMF_FIRST_USERINITED = &amp;H4&amp; NWMF_OVERRIDEKEY = &amp;H8&amp; NWMF_SHOWHELP = &amp;H10&amp; NWMF_HTMLDIALOG = &amp;H20&amp; NWMF_FROMPROXY = &amp;H40&amp; End Enum Private cookie As AxHost.ConnectionPointCookie Private wevents As WebBrowserExtendedEvents '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 WebBrowserExtendedEvents(Me) cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance, wevents, GetType(DWebBrowserEvents2)) 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 WebBrowserNavigatingExtendedEventHandler(ByVal sender As Object, ByVal e As WebBrowserNavigatingExtendedEventArgs) Public Event NavigatingExtended As WebBrowserNavigatingExtendedEventHandler 'This event will fire when a new window is about to be opened Public Delegate Sub WebBrowserNewWindowExtendedEventHandler(ByVal sender As Object, ByVal e As WebBrowserNewWindowExtendedEventArgs) Public Event NewWindowExtended As WebBrowserNewWindowExtendedEventHandler Protected Friend Sub OnNavigatingExtended(ByVal Url As String, ByVal Frame As String, ByVal Postdata As Byte(), ByVal Headers As String, ByRef Cancel As Boolean) Dim e As WebBrowserNavigatingExtendedEventArgs = New WebBrowserNavigatingExtendedEventArgs(Url, Frame, Postdata, Headers) RaiseEvent NavigatingExtended(Me, e) Cancel = e.Cancel End Sub Protected Friend Sub OnNewWindowExtended(ByVal Url As String, ByRef Cancel As Boolean, ByVal Flags As NWMF, ByVal UrlContext As String) Dim e As WebBrowserNewWindowExtendedEventArgs = New WebBrowserNewWindowExtendedEventArgs(Url, UrlContext, Flags) RaiseEvent NewWindowExtended(Me, e) Cancel = e.Cancel End Sub Public Overloads Sub Navigate2(ByVal URL As String) MyBase.Navigate(URL) End Sub #End Region #Region " Extended Event Classes " 'This class will capture events from the WebBrowser Friend Class WebBrowserExtendedEvents Inherits System.Runtime.InteropServices.StandardOleMarshalObject Implements DWebBrowserEvents2 Private m_Browser As eWebbrowser Public Sub New(ByVal browser As eWebbrowser) m_Browser = browser End Sub 'Implement whichever events you wish 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 DWebBrowserEvents2.BeforeNavigate2 m_Browser.OnNavigatingExtended(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 DWebBrowserEvents2.NewWindow3 m_Browser.OnNewWindowExtended(Url, Cancel, CType(Flags, NWMF), UrlContext) End Sub End Class Public Class WebBrowserNewWindowExtendedEventArgs 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 'First define a new EventArgs class to contain the newly exposed data Public Class WebBrowserNavigatingExtendedEventArgs 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 #End Region &lt;ComImport(), Guid("64AB4BB7-111E-11D1-8F79-00C04FC2FBE1")&gt; _ Public Class ShellUIHelper ' End Class End Class </code></pre> <p><br> form load:</p> <pre><code>Public WithEvents wb As eWebbrowser Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim brws As New eWebbrowser wb = brws End Sub </code></pre> <p>Events:</p> <pre><code>Private Sub wb_NewWindow(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles wb.NewWindow e.Cancel = True End Sub </code></pre> <p><br></p> <p>The New Event:</p> <pre><code> Private Sub wb_NewWindowExtended(ByVal sender As Object, ByVal e As eWebbrowser.WebBrowserNewWindowExtendedEventArgs) Handles wb.NewWindowExtended e.Cancel = True Dim url As String = e.Url msgbox(url) //This Is The Url!! End Sub </code></pre>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload