tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
WebBrowserを使ってのHTMファイル内の全ての要素を調査(VB.NET) ( No.0 )  [親スレッドへ]
日時: 2013/02/14 09:21
名前: VBレスキュー(花ちゃん)

***********************************************************************************
* カテゴリー:[インターネット][][]                                                *
* キーワード:ログイン,自動的に,IE,ボタンをクリック,テキスト入力,submit,         *
***********************************************************************************
'==================================================================================
'投 稿 日:2012.01.28
'投 稿 者:VBレスキュー(花ちゃん)
'タイトル:WebBrowserを使ってのHTMファイル内の全ての要素を調査PartU(433)
'動作確認:WindowsVista VB2010(VS2010 Pro) Framework 4 / ターゲットCPU:X86
'[Option Compare Text][Option Explicit On][Option Infer On][Option Strict On]で設定
'VB6.0用を投稿しましたので、VB2010用も作成し、投稿しました。
'==================================================================================
'----------------------------------------------------------------------------------
※ 使用コントロール及び貼り付け位置等は下図の実行結果図を参考にお好みで。
  (一旦現状のままで、動作確認をしてから改造するなり修正するなりしてお使い下さい)
  (尚、満足に動作しないと言う事なら、当サイトの掲示板の方に質問願います。)

   下記リンクの、【WebBrowserを使ってWeb上のTextBoxや各種ボタン等の操作例(VB.NET)】
  と合わせてお使い下さい。
  http://hanatyan.sakura.ne.jp/patio/read.cgi?no=314
'----------------------------------------------------------------------------------

Public Class Form1

#Region "本文関係の処理"

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
'全ての要素を取得(その1)
   TextBox2.Text = ""
   TextBox2.Refresh()
   Dim myText As New System.Text.StringBuilder()
   Dim i As Integer = 0
   Dim he As HtmlElement = Nothing
   myText.Append(fStrCut("No.", 8) & fStrCut("要素名", 15) & fStrCut("Type", 24) & _
   fStrCut("ID", 36) & fStrCut("NAME", 27) & fStrCut("value", 33) & fStrCut("Text", 50) & _
   ControlChars.CrLf & New System.String("-"c, 195) & vbCrLf)
   With WebBrowser1
      For Each he In .Document.All
         If he.TagName = "IFRAME" Or he.TagName = "shape" Then
            '実行時エラーが発生するので無視する(上記以外にもあれば追加して下さい)
            Dim no1 As String = fStrCut(i.ToString, 8)
            Dim tn1 As String = fStrCut(he.TagName, 15) & _
            "★★★★★ 必要な場合別途調査して下さい。★★★★★"
               myText.Append(no1 & tn1 & ControlChars.CrLf)
            i = i + 1
         Else
            '取得したデータを表示する為に加工
            Dim no As String = fStrCut(i.ToString, 8)
            Dim tn As String = fStrCut(he.TagName, 15)
            Dim ty As String = fStrCut(he.GetAttribute("Type"), 24)
            Dim id As String = fStrCut(he.GetAttribute("ID"), 36)
            Dim na As String = fStrCut(he.GetAttribute("NAME"), 24) & "   "
            Dim va As String = fStrCut(he.GetAttribute("value"), 30) & "   "
            Dim tx As String = fStrCut(Replace(he.InnerText, vbCrLf, ""), 50)
            If tn = "IMG            " Then
               va = fStrCut(he.GetAttribute("alt"), 30) & "   "
               tx = fStrCut(he.GetAttribute("src"), 50)
            End If
            If tn = "A              " Then
               va = fStrCut(tx, 30) & "   "
               tx = fStrCut(he.GetAttribute("href"), 50)
            End If
            myText.Append(no & tn & ty & id & na & va & tx & ControlChars.CrLf)
            i = i + 1
         End If
         If (i Mod 30) = 0 Then
            myText.Append(New System.String("-"c, 195) & vbCrLf & fStrCut("No.", 8) & _
            fStrCut("要素名", 15) & fStrCut("Type", 24) & fStrCut("ID", 36) & fStrCut("NAME", 27) & _
            fStrCut("value", 33) & fStrCut("Text", 50) & vbCrLf & New System.String("-"c, 195) & vbCrLf)
         End If
      Next
   End With
   TextBox2.Text = myText.ToString()
End Sub

Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
'全ての要素を取得(その2)
   TextBox2.Text = ""
   TextBox2.Refresh()
   Dim myText As New System.Text.StringBuilder()
   Dim i As Integer = 0
   Dim he As HtmlElement = Nothing
   myText.Append(fStrCut("No.", 6) & fStrCut("F_No", 6) & "  " & fStrCut("要素名", 15) & fStrCut("Type", 24) & _
   fStrCut("ID", 36) & fStrCut("NAME", 27) & fStrCut("value", 33) & fStrCut("Text", 50) & _
   ControlChars.CrLf & New System.String("-"c, 195) & vbCrLf)
   For k As Integer = 0 To WebBrowser1.Document.Forms.Count - 1
      With WebBrowser1
         For Each he In .Document.Forms(k).All
            If he.TagName = "IFRAME" Or he.TagName = "shape" Then
               '実行時エラーが発生するので無視する(上記以外にもあれば追加して下さい)
               Dim no1 As String = fStrCut(i.ToString, 8)
               Dim tn1 As String = fStrCut(he.TagName, 15) & fStrCut("F_No", 6) & _
               "★★★★★ 必要な場合別途調査して下さい。★★★★★"
                  myText.Append(no1 & tn1 & ControlChars.CrLf)
               i = i + 1
            Else
               '取得したデータを表示する為に加工
               Dim no As String = fStrCut(i.ToString, 8)
               Dim tn As String = fStrCut(he.TagName, 15)
               Dim ty As String = fStrCut(he.GetAttribute("Type"), 24)
               Dim id As String = fStrCut(he.GetAttribute("ID"), 36)
               Dim na As String = fStrCut(he.GetAttribute("NAME"), 24) & "   "
               Dim va As String = fStrCut(he.GetAttribute("value"), 30) & "   "
               Dim tx As String = fStrCut(Replace(he.InnerText, vbCrLf, ""), 50)
               If tn = "img            " Then
                  va = fStrCut(he.GetAttribute("alt"), 30) & "   "
                  tx = fStrCut(he.GetAttribute("src"), 50)
               End If
               If tn = "A              " Then
                  va = fStrCut(tx, 30) & "   "
                  tx = fStrCut(he.GetAttribute("href"), 50)
               End If
              myText.Append(no & fStrCut(k.ToString, 6) & tn & ty & id & na & va & tx & ControlChars.CrLf)
               i = i + 1
            End If
            If (i Mod 30) = 0 Then
               myText.Append(New System.String("-"c, 195) & vbCrLf & fStrCut("No.", 6) & fStrCut("F_No", 6) & "  " & _
               fStrCut("要素名", 15) & fStrCut("Type", 24) & fStrCut("ID", 36) & fStrCut("NAME", 27) & _
               fStrCut("value", 33) & fStrCut("Text", 50) & vbCrLf & New System.String("-"c, 195) & vbCrLf)
            End If
         Next
      End With
   Next
   TextBox2.Text = myText.ToString()
End Sub

Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
'指定の要素を取得
   TextBox2.Text = ""
   TextBox2.Refresh()
   Dim myText As New System.Text.StringBuilder()
   Dim i As Integer = 0
   Dim he As HtmlElement = Nothing
   myText.Append(fStrCut("No.", 8) & fStrCut("要素名", 15) & fStrCut("Type", 24) & _
   fStrCut("ID", 36) & fStrCut("NAME", 27) & fStrCut("value", 33) & fStrCut("Text", 50) & _
   ControlChars.CrLf & New System.String("-"c, 195) & vbCrLf)
   With WebBrowser1
      For Each he In .Document.GetElementsByTagName(TextBox3.Text)
         If he.TagName = "IFRAME" Or he.TagName = "shape" Then
            '実行時エラーが発生するので無視する(上記以外にもあれば追加して下さい)
            Dim no1 As String = fStrCut(i.ToString, 8)
            Dim tn1 As String = fStrCut(he.TagName, 15) & _
            "★★★★★ 必要な場合別途調査して下さい。★★★★★"
               myText.Append(no1 & tn1 & ControlChars.CrLf)
            i = i + 1
         Else
            '取得したデータを表示する為に加工
            Dim no As String = fStrCut(i.ToString, 8)
            Dim tn As String = fStrCut(he.TagName, 15)
            Dim ty As String = fStrCut(he.GetAttribute("Type"), 24)
            Dim id As String = fStrCut(he.GetAttribute("ID"), 36)
            Dim na As String = fStrCut(he.GetAttribute("NAME"), 24) & "   "
            Dim va As String = fStrCut(he.GetAttribute("value"), 30) & "   "
            Dim tx As String = fStrCut(Replace(he.InnerText, vbCrLf, ""), 50)
            If tn = "img            " Then
               va = fStrCut(he.GetAttribute("alt"), 30) & "   "
               tx = fStrCut(he.GetAttribute("src"), 50)
            End If
            If tn = "A              " Then
               va = fStrCut(tx, 30) & "   "
               tx = fStrCut(he.GetAttribute("href"), 50)
            End If
            myText.Append(no & tn & ty & id & na & va & tx & ControlChars.CrLf)
            i = i + 1
         End If
         If (i Mod 30) = 0 Then
            myText.Append(New System.String("-"c, 195) & vbCrLf & fStrCut("No.", 8) & _
            fStrCut("要素名", 15) & fStrCut("Type", 24) & fStrCut("ID", 36) & fStrCut("NAME", 27) & _
            fStrCut("value", 33) & fStrCut("Text", 50) & vbCrLf & New System.String("-"c, 195) & vbCrLf)
         End If
      Next
   End With
   TextBox2.Text = myText.ToString()
End Sub

#End Region

#Region "起動時の処理及び付帯処理関係"

Private myUrl As Uri = New Uri("http://www.hanatyan.sakura.ne.jp/testfile1.htm")          '表示するURL
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

   WebBrowser1.Navigate(myUrl)
   Button2.Enabled = False
   Button3.Enabled = False
   Button4.Enabled = False
   Button5.Enabled = False
   With TextBox2
      .Multiline = True
      .ScrollBars = ScrollBars.Both
      .WordWrap = False
      .Text = ""
      .Font = New Font("MS ゴシック", 9, FontStyle.Regular)
   End With
End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
   myUrl = New Uri(TextBox1.Text)
   WebBrowser1.Navigate(myUrl)
   Button2.Enabled = False
   Button3.Enabled = False
   Button4.Enabled = False
   Button5.Enabled = False
End Sub

Private Sub WebBrowser1_DocumentCompleted(sender As System.Object, e As  _
               System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) _
                                          Handles WebBrowser1.DocumentCompleted
   If e.Url <> myUrl Then
      Exit Sub
   End If
   Button2.Enabled = True
   Button3.Enabled = True
   Button4.Enabled = True
   Button5.Enabled = True
End Sub

Private Function fStrCut(ByVal Mystring As String, ByVal nLen As Integer) As String
'文字列を指定のバイト数にカットする関数(漢字分断回避)
   If Mystring Is Nothing Then
      Mystring = "---- "
   End If
   If nLen < 1 Or Mystring.Length < 1 Then
      Mystring = "---- "
   End If
   Dim sjis As System.Text.Encoding = System.Text.Encoding.GetEncoding("Shift_JIS")
   Dim TempLen As Integer = sjis.GetByteCount(Mystring)
   If TempLen <= nLen Then   '文字列が指定のバイト数未満の場合スペースを付加する
      Return Mystring.PadRight(nLen - (TempLen - Mystring.Length), " "c)
   End If
   Dim tempByt() As Byte = sjis.GetBytes(Mystring)
   Dim strTemp As String = sjis.GetString(tempByt, 0, nLen)
   '末尾が漢字分断されたら半角スペースと置き換え(VB2005="・" で.NET2003=NullChar になります)
   If strTemp.EndsWith(ControlChars.NullChar) Or strTemp.EndsWith("・") Then
      strTemp = sjis.GetString(tempByt, 0, nLen - 1) & " "
   End If
   Return strTemp
End Function

Private Sub TextBox1_MouseClick(sender As Object, e As  _
                  System.Windows.Forms.MouseEventArgs) Handles TextBox1.MouseClick
'テキスト ボックスのすべてのテキストを選択する
   TextBox1.SelectAll()
End Sub

#End Region

End Class

実行結果図(画像をクリックすると元のサイズで見る事ができます。)



 [スレッド一覧へ] [親スレッドへ]