VisualBasic2008ExpressEditionでプログラムしています。


次のような処理をするサブルーチンを作りたいです。

1. strUrlに格納されているURLをWebBrowser1で表示をこころみる。
2. WebBrowser1での表示が完全に終了するまで待つ。Timer1に指定された時間が経過したらタイムアウトする。
3. strResultOfShowに、表示に成功した場合は"Success"、タイムアウトしたりエラーが発生した場合は"Failure"を代入する。

つきましては、コードをご教示ください。

回答の条件
  • 1人2回まで
  • 登録:2009/10/21 21:22:00
  • 終了:2009/10/26 14:56:26

ベストアンサー

id:freemann No.1

freemann回答回数307ベストアンサー獲得回数492009/10/22 09:37:50

ポイント100pt

Timer1:Timer

txtURL:TextBox

btnRead:Button

となっています。

エラーのハンドリングは、標準のWebBrowserではできないので、継承してWebBrowser2としています。

動作確認用のMessageBoxが3か所に入っていますが、確認ができましたら削除してください。

Imports System.Runtime.InteropServices

Imports System.Security.Permissions


Public Class Form1

Private strResultOfShow As String

Private strURL As String

Private WithEvents WebBrowser1 As New WebBrowser2

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Timer1.Interval = 60000

Me.Controls.Add(WebBrowser1)

WebBrowser1.Top = 50

WebBrowser1.Left = 5

WebBrowser1.Height = Me.Height - 60

WebBrowser1.Width = Me.Width - 10

WebBrowser1.Visible = True

End Sub

Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

'MessageBox.Show("読み込み完了")

If Timer1.Enabled Then

Timer1.Enabled = False

strResultOfShow = "Success"

MessageBox.Show(strResultOfShow)

Else

strResultOfShow = "Failure"

MessageBox.Show(strResultOfShow, "DocumentCompleted")

End If

End Sub

Private Sub btnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRead.Click

WebBrowser1.Url = New Uri(txtURL.Text)

Timer1.Enabled = True

End Sub


Private Sub WebBrowser1_NavigateError(ByVal sender As System.Object, ByVal e As WebBrowserNavigateErrorEventArgs) Handles WebBrowser1.NavigateError

Timer1.Enabled = False

strResultOfShow = "Failure"

MessageBox.Show(strResultOfShow, "NavigateError")

End Sub


<PermissionSetAttribute(SecurityAction.Demand, Name:="FullTrust")> _

Public Class Form1

Inherits Form

<STAThreadAttribute()> Public Shared Sub Main()

Application.Run(New Form1())

End Sub

Private WithEvents wb As New WebBrowser2()

Public Sub New()

wb.Dock = DockStyle.Fill

Controls.Add(wb)

' Attempt to navigate to an invalid address.

wb.Navigate("www.widgets.microsoft.com")

End Sub

Private Sub wb_NavigateError( _

ByVal sender As Object, _

ByVal e As WebBrowserNavigateErrorEventArgs) _

Handles wb.NavigateError

' Display an error message to the user.

MessageBox.Show("Cannot navigate to " + e.Url)

End Sub

End Class

Public Class WebBrowser2

Inherits WebBrowser

Private cookie As AxHost.ConnectionPointCookie

Private helper As WebBrowser2EventHelper

<PermissionSetAttribute(SecurityAction.LinkDemand, _</p>

Name:="FullTrust")> Protected Overrides Sub CreateSink()

MyBase.CreateSink()

' Create an instance of the client that will handle the event

' and associate it with the underlying ActiveX control.

helper = New WebBrowser2EventHelper(Me)

cookie = New AxHost.ConnectionPointCookie( _

Me.ActiveXInstance, helper, GetType(DWebBrowserEvents2))

End Sub

<PermissionSetAttribute(SecurityAction.LinkDemand, _</p>

Name:="FullTrust")> Protected Overrides Sub DetachSink()

' Disconnect the client that handles the event

' from the underlying ActiveX control.

If cookie IsNot Nothing Then

cookie.Disconnect()

cookie = Nothing

End If

MyBase.DetachSink()

End Sub

Public Event NavigateError As WebBrowserNavigateErrorEventHandler

' Raises the NavigateError event.

Protected Overridable Sub OnNavigateError( _

ByVal e As WebBrowserNavigateErrorEventArgs)

RaiseEvent NavigateError(Me, e)

End Sub

' Handles the NavigateError event from the underlying ActiveX

' control by raising the NavigateError event defined in this class.

Private Class WebBrowser2EventHelper

Inherits StandardOleMarshalObject

Implements DWebBrowserEvents2

Private parent As WebBrowser2

Public Sub New(ByVal parent As WebBrowser2)

Me.parent = parent

End Sub

Public Sub NavigateError(ByVal pDisp As Object, _

ByRef URL As Object, ByRef frame As Object, _

ByRef statusCode As Object, ByRef cancel As Boolean) _

Implements DWebBrowserEvents2.NavigateError

' Raise the NavigateError event.

Me.parent.OnNavigateError( _

New WebBrowserNavigateErrorEventArgs( _

CStr(URL), CStr(frame), CInt(statusCode), cancel))

End Sub

End Class

End Class

' Represents the method that will handle the WebBrowser2.NavigateError event.

Public Delegate Sub WebBrowserNavigateErrorEventHandler(ByVal sender As Object, _

ByVal e As WebBrowserNavigateErrorEventArgs)

' Provides data for the WebBrowser2.NavigateError event.

Public Class WebBrowserNavigateErrorEventArgs

Inherits EventArgs

Private urlValue As String

Private frameValue As String

Private statusCodeValue As Int32

Private cancelValue As Boolean

Public Sub New( _

ByVal url As String, ByVal frame As String, _

ByVal statusCode As Int32, ByVal cancel As Boolean)

Me.urlValue = url

Me.frameValue = frame

Me.statusCodeValue = statusCode

Me.cancelValue = cancel

End Sub

Public Property Url() As String

Get

Return urlValue

End Get

Set(ByVal value As String)

urlValue = value

End Set

End Property

Public Property Frame() As String

Get

Return frameValue

End Get

Set(ByVal value As String)

frameValue = value

End Set

End Property

Public Property StatusCode() As Int32

Get

Return statusCodeValue

End Get

Set(ByVal value As Int32)

statusCodeValue = value

End Set

End Property

Public Property Cancel() As Boolean

Get

Return cancelValue

End Get

Set(ByVal value As Boolean)

cancelValue = value

End Set

End Property

End Class

' Imports the NavigateError method from the OLE DWebBrowserEvents2

' interface.

<ComImport(), Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"), _</p>

InterfaceType(ComInterfaceType.InterfaceIsIDispatch), _

TypeLibType(TypeLibTypeFlags.FHidden)> _

Public Interface DWebBrowserEvents2

<DispId(271)> Sub NavigateError( _

<InAttribute(), MarshalAs(UnmanagedType.IDispatch)> _

ByVal pDisp As Object, _

<InAttribute()> ByRef URL As Object, _

<InAttribute()> ByRef frame As Object, _

<InAttribute()> ByRef statusCode As Object, _

<InAttribute(), OutAttribute()> ByRef cancel As Boolean)

End Interface

End Class

その他の回答(1件)

id:freemann No.1

freemann回答回数307ベストアンサー獲得回数492009/10/22 09:37:50ここでベストアンサー

ポイント100pt

Timer1:Timer

txtURL:TextBox

btnRead:Button

となっています。

エラーのハンドリングは、標準のWebBrowserではできないので、継承してWebBrowser2としています。

動作確認用のMessageBoxが3か所に入っていますが、確認ができましたら削除してください。

Imports System.Runtime.InteropServices

Imports System.Security.Permissions


Public Class Form1

Private strResultOfShow As String

Private strURL As String

Private WithEvents WebBrowser1 As New WebBrowser2

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Timer1.Interval = 60000

Me.Controls.Add(WebBrowser1)

WebBrowser1.Top = 50

WebBrowser1.Left = 5

WebBrowser1.Height = Me.Height - 60

WebBrowser1.Width = Me.Width - 10

WebBrowser1.Visible = True

End Sub

Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

'MessageBox.Show("読み込み完了")

If Timer1.Enabled Then

Timer1.Enabled = False

strResultOfShow = "Success"

MessageBox.Show(strResultOfShow)

Else

strResultOfShow = "Failure"

MessageBox.Show(strResultOfShow, "DocumentCompleted")

End If

End Sub

Private Sub btnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRead.Click

WebBrowser1.Url = New Uri(txtURL.Text)

Timer1.Enabled = True

End Sub


Private Sub WebBrowser1_NavigateError(ByVal sender As System.Object, ByVal e As WebBrowserNavigateErrorEventArgs) Handles WebBrowser1.NavigateError

Timer1.Enabled = False

strResultOfShow = "Failure"

MessageBox.Show(strResultOfShow, "NavigateError")

End Sub


<PermissionSetAttribute(SecurityAction.Demand, Name:="FullTrust")> _

Public Class Form1

Inherits Form

<STAThreadAttribute()> Public Shared Sub Main()

Application.Run(New Form1())

End Sub

Private WithEvents wb As New WebBrowser2()

Public Sub New()

wb.Dock = DockStyle.Fill

Controls.Add(wb)

' Attempt to navigate to an invalid address.

wb.Navigate("www.widgets.microsoft.com")

End Sub

Private Sub wb_NavigateError( _

ByVal sender As Object, _

ByVal e As WebBrowserNavigateErrorEventArgs) _

Handles wb.NavigateError

' Display an error message to the user.

MessageBox.Show("Cannot navigate to " + e.Url)

End Sub

End Class

Public Class WebBrowser2

Inherits WebBrowser

Private cookie As AxHost.ConnectionPointCookie

Private helper As WebBrowser2EventHelper

<PermissionSetAttribute(SecurityAction.LinkDemand, _</p>

Name:="FullTrust")> Protected Overrides Sub CreateSink()

MyBase.CreateSink()

' Create an instance of the client that will handle the event

' and associate it with the underlying ActiveX control.

helper = New WebBrowser2EventHelper(Me)

cookie = New AxHost.ConnectionPointCookie( _

Me.ActiveXInstance, helper, GetType(DWebBrowserEvents2))

End Sub

<PermissionSetAttribute(SecurityAction.LinkDemand, _</p>

Name:="FullTrust")> Protected Overrides Sub DetachSink()

' Disconnect the client that handles the event

' from the underlying ActiveX control.

If cookie IsNot Nothing Then

cookie.Disconnect()

cookie = Nothing

End If

MyBase.DetachSink()

End Sub

Public Event NavigateError As WebBrowserNavigateErrorEventHandler

' Raises the NavigateError event.

Protected Overridable Sub OnNavigateError( _

ByVal e As WebBrowserNavigateErrorEventArgs)

RaiseEvent NavigateError(Me, e)

End Sub

' Handles the NavigateError event from the underlying ActiveX

' control by raising the NavigateError event defined in this class.

Private Class WebBrowser2EventHelper

Inherits StandardOleMarshalObject

Implements DWebBrowserEvents2

Private parent As WebBrowser2

Public Sub New(ByVal parent As WebBrowser2)

Me.parent = parent

End Sub

Public Sub NavigateError(ByVal pDisp As Object, _

ByRef URL As Object, ByRef frame As Object, _

ByRef statusCode As Object, ByRef cancel As Boolean) _

Implements DWebBrowserEvents2.NavigateError

' Raise the NavigateError event.

Me.parent.OnNavigateError( _

New WebBrowserNavigateErrorEventArgs( _

CStr(URL), CStr(frame), CInt(statusCode), cancel))

End Sub

End Class

End Class

' Represents the method that will handle the WebBrowser2.NavigateError event.

Public Delegate Sub WebBrowserNavigateErrorEventHandler(ByVal sender As Object, _

ByVal e As WebBrowserNavigateErrorEventArgs)

' Provides data for the WebBrowser2.NavigateError event.

Public Class WebBrowserNavigateErrorEventArgs

Inherits EventArgs

Private urlValue As String

Private frameValue As String

Private statusCodeValue As Int32

Private cancelValue As Boolean

Public Sub New( _

ByVal url As String, ByVal frame As String, _

ByVal statusCode As Int32, ByVal cancel As Boolean)

Me.urlValue = url

Me.frameValue = frame

Me.statusCodeValue = statusCode

Me.cancelValue = cancel

End Sub

Public Property Url() As String

Get

Return urlValue

End Get

Set(ByVal value As String)

urlValue = value

End Set

End Property

Public Property Frame() As String

Get

Return frameValue

End Get

Set(ByVal value As String)

frameValue = value

End Set

End Property

Public Property StatusCode() As Int32

Get

Return statusCodeValue

End Get

Set(ByVal value As Int32)

statusCodeValue = value

End Set

End Property

Public Property Cancel() As Boolean

Get

Return cancelValue

End Get

Set(ByVal value As Boolean)

cancelValue = value

End Set

End Property

End Class

' Imports the NavigateError method from the OLE DWebBrowserEvents2

' interface.

<ComImport(), Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"), _</p>

InterfaceType(ComInterfaceType.InterfaceIsIDispatch), _

TypeLibType(TypeLibTypeFlags.FHidden)> _

Public Interface DWebBrowserEvents2

<DispId(271)> Sub NavigateError( _

<InAttribute(), MarshalAs(UnmanagedType.IDispatch)> _

ByVal pDisp As Object, _

<InAttribute()> ByRef URL As Object, _

<InAttribute()> ByRef frame As Object, _

<InAttribute()> ByRef statusCode As Object, _

<InAttribute(), OutAttribute()> ByRef cancel As Boolean)

End Interface

End Class

id:HALSPECIAL No.2

HALSPECIAL回答回数407ベストアンサー獲得回数862009/10/22 09:55:45

ポイント100pt

未確認ですが、こちらでいかがでしょうか。

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim strUrl As String = "http://www.google.co.jp"
    Dim strResultOfShow As String = "Failure"
    Dim Timer1 As Integer = 10  'タイムアウト10秒

    '指定のページへ移動
    WebBrowser1.Navigate(strUrl)

    '待機
    For i As Integer = 1 To (Timer1 * 5)
        If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
            strResultOfShow = "Success"
            Exit For
        End If
        Application.DoEvents()
        System.Threading.Thread.Sleep(200)
    Next

    '結果
    MsgBox(strResultOfShow)
End Sub

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません