応用

スクリプトエラーを表示しない、画像非表示、JavaScript非実行

  • WebBrowserコントロールには、「スクリプトエラーを表示しない」「画像を非表示にする」「JavaScriptを実行しない」等、 設定ができるプロパティがありません。
  • WebBrowserコントロールを拡張し、これらを設定可能にします。
  • 下記参考先のサイトにソースが完璧にまとめられていましたので、引用しました。

■Form1.vb

							Public Class Form1

								Private _webBrowerCtrl As WebBrowserControler

								Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
									'FormLoadではオブジェクトの作成が上手く動作しなかったので、Shownイベントに実装
									_webBrowerCtrl = New WebBrowserControler(WebBrowser1)
									_webBrowerCtrl.DlControl = _webBrowerCtrl.DlControl And Not DLCTL.DLIMAGES	'画像を非表示
									'_webBrowerCtrl.DlControl = _webBrowerCtrl.DlControl Or DLCTL.DLIMAGES		'画像を表示
									_webBrowerCtrl.DlControl = _webBrowerCtrl.DlControl Or DLCTL.NO_SCRIPTS		'スクリプトを実行しない
									WebBrowser1.Navigate("http://www.yahoo.co.jp")
								End Sub

							End Class
						

■WebBrowserControler.vb

							Imports System.Runtime.InteropServices

							<ComVisible(True)> _
							Public Class WebBrowserControler
								Inherits Control
								Implements IOleClientSite

								Private Const DISPID_AMBIENT_DLCONTROL As Integer = -5512
								Private _WebBrowser As WebBrowser
								Private _DlControl As DLCTL = DLCTL.DLIMAGES Or DLCTL.BGSOUNDS Or DLCTL.VIDEOS

								Public Sub New(ByVal WebBrowser As WebBrowser)
									Me._WebBrowser = WebBrowser
									DirectCast(Me._WebBrowser.ActiveXInstance, IOleObject).SetClientSite(Me)
								End Sub

								<DispId(DISPID_AMBIENT_DLCONTROL)> _
								Public Function Didpid_Ambient_DlControl() As Integer
									Return Me._DlControl
								End Function

								Private Sub OnAmbientPropertyChange()
									DirectCast(Me._WebBrowser.ActiveXInstance.Application, IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL)
								End Sub

								Public Property DlControl() As DLCTL
									Get
										Return Me._DlControl
									End Get
									Set(ByVal value As DLCTL)
										Me._DlControl = value
										Me.OnAmbientPropertyChange()
										Me._WebBrowser.Refresh()
									End Set
								End Property

								Public Sub GetContainer(ByRef ppContainer As Object) Implements IOleClientSite.GetContainer
								End Sub
								Public Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByRef ppmk As Object) Implements IOleClientSite.GetMoniker
								End Sub
								Public Sub OnShowWindow(ByVal fShow As Boolean) Implements IOleClientSite.OnShowWindow
								End Sub
								Public Sub RequestNewObjectLayout() Implements IOleClientSite.RequestNewObjectLayout
								End Sub
								Public Sub SaveObject() Implements IOleClientSite.SaveObject
								End Sub
								Public Sub ShowObject() Implements IOleClientSite.ShowObject
								End Sub

							End Class

							Public Enum DLCTL As Integer
								BGSOUNDS = &H40				'BGMを再生する
								DLIMAGES = &H10				'サーバーから画像をダウンロードする
								DOWNLOADONLY = &H800		'コンポーネントをダウンロードするが表示しない
								FORCEOFFLINE = &H10000000	'常にオフラインモード
								NO_BEHAVIORS = &H8000
								NO_CLIENTPULL = &H20000000
								NO_DLACTIVEXCTLS = &H400	'ActiveXコントロールをダウンロードしない
								NO_FRAMEDOWNLOAD = &H1000	'フレームをダウンロードしない
								NO_JAVA = &H100				'JAVAアプレットを実行しない
								NO_METACHARSET = &H10000
								NO_RUNACTIVEXCTLS = &H200	'ActiveXコントロールを実行しない
								NO_SCRIPTS = &H80			'スクリプトを実行しない
								OFFLINE = &H80000000
								OFFLINEIFNOTCONNECTED = &H80000000
								PRAGMA_NO_CACHE = &H4000
								RESYNCHRONIZE = &H2000
								SILENT = &H40000000			'ダイアログを表示しない
								URL_ENCODING_DISABLE_UTF8 = &H20000
								URL_ENCODING_ENABLE_UTF8 = &H40000
								VIDEOS = &H20				'ビデオクリップを再生する
							End Enum

							<GuidAttribute("B196B288-BAB4-101A-B69C-00AA00341D07"), _
							InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
							Public Interface IOleControl

								Sub GetControlInfo(ByRef pCI As Object)
								Sub OnMnemonic(ByRef pMsg As Object)
								Sub OnAmbientPropertyChange(ByVal dispID As Integer)
								Sub FreezeEvents(ByVal bFreeze As Boolean)

							End Interface

							<Guid("00000118-0000-0000-C000-000000000046"), _
							InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
							Public Interface IOleClientSite

								Sub SaveObject()
								Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByRef ppmk As Object)
								Sub GetContainer(ByRef ppContainer As Object)
								Sub ShowObject()
								Sub OnShowWindow(ByVal fShow As Boolean)
								Sub RequestNewObjectLayout()

							End Interface

							<Guid("00000112-0000-0000-C000-000000000046"), _
							InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
							Public Interface IOleObject

								Sub SetClientSite(ByVal pClientSite As IOleClientSite)
								Sub GetClientSite(ByRef ppClientSite As IOleClientSite)
								Sub SetHostNames(ByVal szContainerApp As Object, ByVal szContainerObj As Object)
								Sub Close(ByVal dwSaveOption As Integer)
								Sub SetMoniker(ByVal dwWhichMoniker As Integer, ByVal pmk As Object)
								Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByVal ppmk As Object)
								Sub InitFromData(ByVal pDataObject As IDataObject, ByVal fCreation As Boolean, ByVal dwReserved As Integer)
								Sub GetClipboardData(ByVal dwReserved As Integer, ByRef ppDataObject As IDataObject)
								Sub DoVerb(ByVal iVerb As Integer, ByVal lpmsg As Integer, ByVal pActiveSite As Object, ByVal lindex As Integer, ByVal hwndParent As Integer, ByVal lprcPosRect As Integer)
								Sub EnumVerbs(ByRef ppEnumOleVerb As Object)
								Sub Update()
								Sub IsUpToDate()
								Sub GetUserClassID(ByVal pClsid As Integer)
								Sub GetUserType(ByVal dwFormOfType As Integer, ByVal pszUserType As Integer)
								Sub SetExtent(ByVal dwDrawAspect As Integer, ByVal psizel As Integer)
								Sub GetExtent(ByVal dwDrawAspect As Integer, ByVal psizel As Integer)
								Sub Advise(ByVal pAdvSink As Object, ByVal pdwConnection As Integer)
								Sub Unadvise(ByVal dwConnection As Integer)
								Sub EnumAdvise(ByRef ppenumAdvise As Object)
								Sub GetMiscStatus(ByVal dwAspect As Integer, ByVal pdwStatus As Integer)
								Sub SetColorScheme(ByVal pLogpal As Object)

							End Interface
						

参考

WebBrowserコントロールを制御する