サンプル投稿用掲示板 VB2005 ～ 用トップページ VB6.0 用 トップページ
- 日時： 2013/02/14 09:21
- 名前： VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー：[インターネット][][] *
* キーワード：ログイン,自動的に,IE,ボタンをクリック,テキスト入力,submit, *
***********************************************************************************
'==================================================================================
'投 稿 日：2012.01.28
'投 稿 者：VBレスキュー(花ちゃん)
'タイトル：WebBrowserを使ってのHTMファイル内の全ての要素を調査PartⅡ(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
'全ての要素を取得(その１)
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
'全ての要素を取得(その２)
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("ＭＳ ゴシック", 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
実行結果図(画像をクリックすると元のサイズで見る事ができます。)
 |
スーパーコピー 服 メンズ ランキング