2013年12月版 Internet Explorer（IE）制御クラス

Public Class IEWrapper

  Private __ie As SHDocVw.InternetExplorer
  Private Property _ie() As SHDocVw.InternetExplorer
    Get
      Return __ie
    End Get
    Set(value As SHDocVw.InternetExplorer)
      __ie = value
      RootFrame()
    End Set
  End Property

  Private __currentDoc As mshtml.IHTMLDocument2
  Private Property _currentDoc() As mshtml.IHTMLDocument2
    Get
      Return __currentDoc
    End Get
    Set(value As mshtml.IHTMLDocument2)
      __currentDoc = value
      Dim startTime = DateTime.Now
      While __currentDoc.readyState <> "complete"
        System.Windows.Forms.Application.DoEvents()
        System.Threading.Thread.Sleep(100)
        If DateTime.Now - startTime > MAX_WAIT_TIMEOUT Then
          Throw New TimeoutException("WaitIEでタイムアウトしました。")
        End If
      End While
      RootElement()
    End Set
  End Property

  Private _currentElement As mshtml.IHTMLElement2

  ''' <summary>
  ''' ルートフレームを参照します。
  ''' </summary>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function RootFrame() As IEWrapper
    _currentDoc = DirectCast(_ie.Document, mshtml.IHTMLDocument2)
    Return Me
  End Function

  ''' <summary>
  ''' ルート要素を参照します。
  ''' </summary>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function RootElement() As IEWrapper
    _currentElement = DirectCast(DirectCast(_currentDoc, mshtml.IHTMLDocument3).documentElement, mshtml.IHTMLElement2)
    Return Me
  End Function

  ''' <summary>
  ''' IEインスタンスを生成します。
  ''' </summary>
  Public Sub New()
    __ie = New SHDocVw.InternetExplorer()
    __ie.Visible = True
  End Sub

  Private Shared ReadOnly MAX_WAIT_TIMEOUT As New TimeSpan(0, 0, 15)

  ''' <summary>
  ''' 指定されたURLに移動します。
  ''' </summary>
  ''' <param name="url">移動するURL</param>
  ''' <returns>移動に成功したかどうか</returns>
  Public Function TryGotoUrl(url As String) As Boolean
    Try
      GotoUrl(url)
      Return True
    Catch ex As TimeoutException
    End Try
    Return False
  End Function

  ''' <summary>
  ''' 指定されたURLに移動します。移動に失敗した場合は、TimeoutExceptionを発生します。
  ''' </summary>
  ''' <param name="url">移動するURL</param>
  Public Sub GotoUrl(url As String)
    _ie.Navigate(url)
    WaitIE()
    RootFrame().RootElement()
  End Sub

  ' IEがビジー状態の間待ちます 戻り値はタイムアウトせず成功したか。
  Private Function TryWaitIE() As Boolean
    Try
      WaitIE()
      Return True
    Catch ex As TimeoutException
    End Try
    Return False
  End Function

  ''' <summary>
  ''' IEがビジー状態の間待ちます。タイムアウトした場合は、TimeoutExceptionを発生します。
  ''' </summary>
  Private Sub WaitIE()
    Dim startTime = DateTime.Now
    While _ie.Busy = True OrElse _ie.ReadyState <> SHDocVw.tagREADYSTATE.READYSTATE_COMPLETE
      System.Windows.Forms.Application.DoEvents()
      System.Threading.Thread.Sleep(100)
      If DateTime.Now - startTime > MAX_WAIT_TIMEOUT Then
        Throw New TimeoutException("WaitIEでタイムアウトしました。")
      End If
    End While
  End Sub

  ''' <summary>
  ''' 現在参照している要素のInnerText
  ''' </summary>
  Public ReadOnly Property InnerText() As String
    Get
      Return DirectCast(_currentElement, mshtml.IHTMLElement).innerText
    End Get
  End Property

  ''' <summary>
  ''' 現在参照している要素のInnerHtml
  ''' </summary>
  Public ReadOnly Property InnerHtml() As String
    Get
      Return DirectCast(_currentElement, mshtml.IHTMLElement).innerHTML
    End Get
  End Property

  ''' <summary>
  ''' 指定されたフレームを参照します。
  ''' </summary>
  ''' <param name="name">フレーム名</param>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function Frame(name As String) As IEWrapper
    Dim frames = _currentDoc.frames

    For i = 0 To frames.length - 1
      Dim obj As Object = i
      Dim frame__1 = DirectCast(frames.item(obj), mshtml.IHTMLWindow2)
      If frame__1.name = name Then
        Dim startTime = DateTime.Now
        While frame__1.document.readyState <> "complete"
          System.Threading.Thread.Sleep(100)
          System.Windows.Forms.Application.DoEvents()
          If DateTime.Now - startTime > MAX_WAIT_TIMEOUT Then
            Throw New TimeoutException("WaitIEでタイムアウトしました。")
          End If
        End While
        _currentDoc = frame__1.document
        Return Me
      End If
    Next
    Throw New ArgumentException(String.Format("指定されたnameのFrameは見つかりません。name={0}", name))
  End Function

  ''' <summary>
  ''' 現在参照している要素をクリックします。
  ''' </summary>
  ''' <returns>クリックに成功したかどうか</returns>
  Public Function TryClick() As Boolean
    Try
      Click()
      Return True
    Catch ex As TimeoutException
    End Try
    Return False
  End Function

  ''' <summary>
  ''' 現在参照している要素をクリックします。
  ''' </summary>
  Public Sub Click()
    ClickNoWait()
    WaitIE()
  End Sub

  ''' <summary>
  ''' 現在参照している要素をクリックします。IEのビジー状態は待ちません。
  ''' </summary>
  Public Sub ClickNoWait()
    DirectCast(_currentElement, mshtml.IHTMLElement).click()
  End Sub

  ''' <summary>
  ''' 指定されたDomIDの要素を取得します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <returns>指定された要素</returns>
  Protected Function GetElementById(domIdOrName As String) As mshtml.IHTMLElement
    Dim startTime = DateTime.Now
    Dim result As mshtml.IHTMLElement = Nothing

    '要素が出現するまで待ちます
    Do
      ' IEのgetElementByIdはidだけでなくnameも参照する
      result = DirectCast(_currentDoc, mshtml.IHTMLDocument3).getElementById(domIdOrName)
      System.Windows.Forms.Application.DoEvents()
      If DateTime.Now - startTime > MAX_WAIT_TIMEOUT Then
        Throw New TimeoutException("タイムアウトしました。domId=" & domIdOrName)
      End If
    Loop While result Is Nothing

    Return result
  End Function

  ''' <summary>
  ''' 指定されたDomID、インデックス要素を取得します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="index">インデックス</param>
  ''' <returns>指定された要素</returns>
  Protected Function GetElementByNames(domIdOrName As String, index As Integer) As mshtml.IHTMLElement

    Dim startTime = DateTime.Now
    Dim result As mshtml.IHTMLElement = Nothing

    '要素が出現するまで待ちます
    Do
      result = DirectCast(DirectCast(_currentDoc, mshtml.IHTMLDocument3).getElementsByName(domIdOrName).item(index, Nothing), mshtml.IHTMLElement)
      System.Windows.Forms.Application.DoEvents()
      If DateTime.Now - startTime > MAX_WAIT_TIMEOUT Then
        Throw New TimeoutException("タイムアウトしました。domId=" & domIdOrName)
      End If
    Loop While result Is Nothing

    Return result
  End Function

  ''' <summary>
  ''' 指定されたタグ、インデックスの要素を参照します。
  ''' </summary>
  ''' <param name="tagName">タグ</param>
  ''' <param name="index">インデックス</param>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function Element(tagName As String, index As Integer) As IEWrapper
    _currentElement = DirectCast(ElementCollection(tagName).item(index, Nothing), mshtml.IHTMLElement2)
    Return Me
  End Function

  Private Function ElementCollection(tagName As String) As mshtml.IHTMLElementCollection
    Return _currentElement.getElementsByTagName(tagName)
  End Function

  ''' <summary>
  ''' 指定されたタグの要素数を取得します。
  ''' </summary>
  ''' <param name="tagName">タグ</param>
  ''' <returns>指定されたタグの要素数</returns>
  Public Function ElementLength(tagName As String) As Integer
    Return _currentElement.getElementsByTagName(tagName).length
  End Function

  ''' <summary>
  ''' 指定されたDomIDの要素を参照します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function ElementById(domIdOrName As String) As IEWrapper
    _currentElement = DirectCast(GetElementById(domIdOrName), mshtml.IHTMLElement2)
    Return Me
  End Function

  ''' <summary>
  ''' 現在の参照の親要素を参照します。
  ''' </summary>
  ''' <returns>参照後のこのインスタンスへの参照</returns>
  Public Function ParentElement() As IEWrapper
    _currentElement = DirectCast(DirectCast(_currentElement, mshtml.IHTMLElement).parentElement, mshtml.IHTMLElement2)
    Return Me
  End Function

  ''' <summary>
  ''' 現在参照している要素がnullかどうかを取得します。
  ''' </summary>
  ''' <returns>nullかどうかを表す値</returns>
  Public Function IsNothingElement() As Boolean
    If _currentElement Is Nothing Then
      Return True
    End If
    Return False
  End Function

  ''' <summary>
  ''' 指定した要素に文字列を入力します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="value">入力する文字列</param>
  Public Sub TypeValue(domIdOrName As String, value As String)
    TypeValue(domIdOrName, value, 0)
  End Sub

  ''' <summary>
  ''' 指定した要素に文字列を入力します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="value">入力する文字列</param>
  ''' <param name="index">インデックス</param>
  Public Sub TypeValue(domIdOrName As String, value As String, index As Integer)
    Dim inputElm As mshtml.IHTMLInputElement = Nothing
    If index = 0 Then
      inputElm = DirectCast(GetElementById(domIdOrName), mshtml.IHTMLInputElement)
    Else
      inputElm = DirectCast(GetElementByNames(domIdOrName, index), mshtml.IHTMLInputElement)
    End If
    inputElm.value = value
    System.Threading.Thread.Sleep(100)
  End Sub

  ''' <summary>
  ''' 指定したテキストエリアに文字列を入力します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="value">入力する文字列</param>
  Public Sub TypeTextArea(domIdOrName As String, value As String)
    Dim textElm = DirectCast(GetElementById(domIdOrName), mshtml.IHTMLTextAreaElement)
    textElm.value = value
    System.Threading.Thread.Sleep(100)
  End Sub

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  ''' <returns>クリックに成功したかどうかを表す値</returns>
  Public Function TryClickSubmit() As Boolean
    Return TryClickSubmit("")
  End Function

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  ''' <param name="domId">DomID</param>
  ''' <returns>クリックに成功したかどうかを表す値</returns>
  Public Function TryClickSubmit(domId As String) As Boolean
    Return TryClickSubmit(0, domId)
  End Function

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  ''' <param name="id">ID</param>
  ''' <returns>クリックに成功したかどうかを表す値</returns>
  Public Function TryClickSubmit(id As Integer) As Boolean
    Return TryClickSubmit(id, "")
  End Function

  Private Function TryClickSubmit(id As Integer, domId As String) As Boolean
    Try
      ClickSubmit(id, domId)
      Return True
    Catch ex As TimeoutException
    End Try
    Return False
  End Function

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  Public Sub ClickSubmit()
    ClickSubmit("")
  End Sub

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  ''' <param name="domId">DomID</param>
  Public Sub ClickSubmit(domId As String)
    ClickSubmit(0, domId)
  End Sub

  ''' <summary>
  ''' 送信ボタンをクリックします。
  ''' </summary>
  ''' <param name="id">ID</param>
  Public Sub ClickSubmit(id As Integer)
    ClickSubmit(id, "")
  End Sub

  Private Sub ClickSubmit(id As Integer, domIdOrName As String)
    If String.IsNullOrEmpty(domIdOrName) Then
      Dim form = DirectCast(_currentDoc.forms.item(id, Nothing), mshtml.IHTMLFormElement)
      form.submit()
    Else
      GetElementById(domIdOrName).click()
    End If
    WaitIE()
  End Sub

  ''' <summary>
  ''' アンカーをクリックします。
  ''' </summary>
  ''' <param name="text">アンカー文字列</param>
  Public Sub ClickAnchor(text As String)
    For i = 0 To ElementLength("a") - 1
      Dim item = ElementCollection("a").item(i, Nothing)
      If item Is Nothing Then
        Continue For
      End If
      Dim htmlItem = DirectCast(item, mshtml.IHTMLElement)

      Dim anchorText = htmlItem.innerText
      If anchorText Is Nothing Then
        Continue For
      End If
      If anchorText = text Then
        htmlItem.click()
        WaitIE()
        Return
      End If
    Next
    Throw New ArgumentException(String.Format("指定されたtextのAnchorは見つかりません。text={0}", text))
  End Sub

  ''' <summary>
  ''' 要素をクリックします。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  Protected Sub ClickInputElement(domIdOrName As String)
    GetElementById(domIdOrName).click()
    System.Threading.Thread.Sleep(100)
  End Sub

  ''' <summary>
  ''' チェックボックスの状態をセットします。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="check">チェック</param>
  Public Sub SetCheckBox(domIdOrName As String, check As Boolean)
    ' 希望通りのチェック状態でなければクリック
    Dim checkBox = DirectCast(GetElementById(domIdOrName), mshtml.IHTMLInputElement)
    If Not (checkBox.checked = check) Then
      ClickInputElement(domIdOrName)
    End If
  End Sub

  ''' <summary>
  ''' セレクトボックスをラベルベースで選択します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <param name="label">ラベル</param>
  Public Sub SetSelectBox(domIdOrName As String, label As String)
    Dim selectElm = DirectCast(GetElementById(domIdOrName), mshtml.HTMLSelectElement)
    Dim ops = DirectCast(selectElm.options, mshtml.IHTMLElementCollection)
    For i = 0 To ops.length - 1
      ' textが同じか
      If (DirectCast(ops.item(i, Nothing), mshtml.IHTMLElement)).innerText = label Then
        DirectCast(ops.item(i, Nothing), mshtml.IHTMLOptionElement).selected = True
        System.Threading.Thread.Sleep(100)
        Return
      End If
    Next
    Throw New ArgumentException(String.Format("指定されたlabelのselectBoxは見つかりません。domId={0} label={1}", domIdOrName, label))
  End Sub

  ''' <summary>
  ''' ラジオボタンを値ベースで選択します。
  ''' </summary>
  ''' <param name="name">名前</param>
  ''' <param name="value">値</param>
  Public Sub SetRadioButton(name As String, value As String)
    Dim radios = DirectCast((DirectCast(_currentDoc, mshtml.IHTMLDocument3)).getElementsByName(name), mshtml.IHTMLElementCollection)
    For i = 0 To radios.length - 1
      Dim rdo = DirectCast(radios.item(i, Nothing), mshtml.IHTMLInputElement)
      If rdo.value = value Then
        Dim ele = DirectCast(radios.item(i, Nothing), mshtml.IHTMLElement)
        ele.click()
        System.Threading.Thread.Sleep(100)
        Return
      End If
    Next
    Throw New ArgumentException(String.Format("指定されたvalueのradioButtonは見つかりません。name={0} value={1}", name, value))
  End Sub

  ''' <summary>
  ''' 指定された要素が存在するかどうかを取得します。
  ''' </summary>
  ''' <param name="domIdOrName">DomID、または、名前</param>
  ''' <returns>指定された要素が存在するか</returns>
  Public Function IsExistElementById(domIdOrName As String) As Boolean
    Dim result = DirectCast(_currentDoc, mshtml.IHTMLDocument3).getElementById(domIdOrName)
    If result Is Nothing Then
      Return False
    End If
    Return True
  End Function

  ''' <summary>
  ''' IEを終了します。
  ''' </summary>
  Public Sub Quit()
    _ie.Quit()
  End Sub

  ''' <summary>
  ''' ひとつ前のページに戻ります。
  ''' </summary>
  Public Sub GotoBack()
    _ie.GoBack()
    WaitIE()
  End Sub

End Class