C# と VB.NET の質問掲示板

Public Class Form1

    Private tv As New TreeView()
    Private sp As New SplitContainer()
    Private WithEvents wb As New WebBrowser()
    Private WithEvents bt As New Button()
    Private WithEvents bt2 As New Button()
    Private tx As New TextBox()
    Private pr As New ProgressBar()
    Private WithEvents tm As New Timer()

    Private postCounter As Long = 0

    Private _Urienum As IEnumerator

    Private Structure HtmlTag
        Private _Title As String
        Private _Href As String
        Private _IsExpand As Boolean

        Public ReadOnly Property IsExpand() As Boolean
            Get
                Return _IsExpand
            End Get
        End Property
        Public Property Title() As String
            Get
                Return _Title
            End Get
            Set(ByVal value As String)
                _Title = value
            End Set
        End Property
        Public Property Href() As String
            Get
                Return _Href
            End Get
            Set(ByVal value As String)
                _Href = value
            End Set
        End Property

        Public Overrides Function ToString() As String
            Dim sb As New System.Text.StringBuilder()

            Dim ss As String
            If Me.IsExpand Then ss = "◆" Else ss = "×"
            sb.Append(ss).Append(Title).Append(" >> ").Append(Href)

            Return sb.ToString()

        End Function
        Public Sub New(ByVal tag As HtmlElement, ByVal bExpand As Boolean)
            _Title = tag.GetAttribute("title")
            _Href = tag.GetAttribute("href")
            _IsExpand = bExpand
        End Sub
    End Structure

    Private timeout As Integer = 0
    Private timeoutTime As Integer = 2
    Public Sub tm_Tick(ByVal sender As System.Object, ByVal e As EventArgs) Handles tm.Tick

        Dim dom As HtmlElement = wb.Document.GetElementsByTagName("title").Item(0)

        If dom.Id.Equals("Done") Or _
            wb.ReadyState = WebBrowserReadyState.Complete Or _
            wb.ReadyState = WebBrowserReadyState.Interactive Or _
            timeout > timeoutTime Then
            tm.Stop()

            Console.WriteLine("DomTitle::{0}", dom.Id)
            If timeout > timeoutTime Then
                Console.WriteLine("timeout")
            End If
            timeout = 0
            If _Urienum.MoveNext() Then
                Dim tag As HtmlTag = DirectCast(_Urienum.Current, HtmlTag)
                Console.WriteLine("展開中: {0}", tag.Href)
                dom.Id = "work"

                wb.Url = New Uri(tag.Href)

                pr.Value += 1
                pr.Update()
                tm.Interval = 1000
                tm.Start()
            Else
                bt.Enabled = True
                bt2.Enabled = False
                MsgBox("終了")
            End If

        Else
            timeout += 1
            wb.Update()

            Console.WriteLine("DomTitle::{0}", dom.Id)
        End If

    End Sub

    Private DomTitleElement As HtmlElement


    Private Sub wb_Completed(ByVal sender As System.Object, ByVal e As WebBrowserDocumentCompletedEventArgs) Handles wb.DocumentCompleted
        '' ブラウザ内スクリプトとの通信用変数
        DomTitleElement = wb.Document.GetElementsByTagName("title").Item(0)
        DomTitleElement.Id = "None"

        Console.WriteLine("complete: {0}::{1}::", e.Url.ToString, DomTitleElement.Id)

        ''ScriptInjection !!
        wb.Url = New Uri("javascript:s=''+WebForm_DoCallback;s=s.replace('return;','document.getElementsByTagName(\'title\')[0].id=\'Done\';return;');eval(s);")
        ''WebForm_DoCallback() XmlHttpRequest を使うメソッドの出口を書き換える
        ''XmlHttp が正常終了すると、window.title.id = 'Done' がセットされる。
    End Sub



    Private Sub bt2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt2.Click
        bt.Enabled = False
        timeout = 0
        tm.Interval = 50
        DomTitleElement.Id = "Done"
        tm.Start()

    End Sub

    ''' <summary>
    ''' URLリスト作成
    ''' </summary>
    Private Sub bt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bt.Click
        Dim doc As HtmlDocument = wb.Document
        Dim tbs As IEnumerator = doc.GetElementsByTagName("table").GetEnumerator()

        Dim list As ArrayList = New ArrayList()

        Do While tbs.MoveNext()
            Dim tbl As HtmlElement = DirectCast(tbs.Current, HtmlElement)

            Dim ans As HtmlElementCollection = tbl.GetElementsByTagName("A")
            If ans.Count = 2 Then
                ''Toggle/Populate TreeNode
                Dim tag As HtmlElement = DirectCast(ans.Item(0), HtmlElement)
                Dim html As HtmlTag = New HtmlTag(tag, True)
                ''ツリーの展開用スクリプトだけ保存
                If html.Href.IndexOf("PopulateNode") > -1 Then
                    list.Add(html)
                    Console.WriteLine("ListAdd: " + html.Href)
                End If
            End If
        Loop

        _Urienum = list.GetEnumerator()
        pr.Step = 1
        pr.Minimum = 0
        pr.Maximum = list.Count
        pr.Value = 0
        pr.Update()

        bt.Enabled = False
        bt2.Enabled = True

    End Sub
    Private Function MyInitLayout() As Panel
        Dim pn1 As New TableLayoutPanel()
        Dim pn2 As New TableLayoutPanel()

        pn1.RowCount = 1
        pn1.ColumnCount = 4
        pn1.Dock = DockStyle.Fill
        bt.Text = "tree"
        bt.Size = New Size(40, 20)
        bt2.Text = "recr"
        bt2.Size = New Size(40, 20)
        pr.Size = New Size(120, 20)
        tx.Dock = DockStyle.Fill
        tx.BorderStyle = BorderStyle.FixedSingle

        pn1.Controls.Add(bt, 0, 0)
        pn1.Controls.Add(bt2, 1, 0)
        pn1.Controls.Add(pr, 2, 0)
        pn1.Controls.Add(tx, 3, 0)

        pn2.RowCount = 2
        pn2.ColumnCount = 1
        pn2.Dock = DockStyle.Fill

        tv.Dock = DockStyle.Fill
        sp.Dock = DockStyle.Fill
        wb.Dock = DockStyle.Fill
        tv.BorderStyle = BorderStyle.None
        sp.Panel1.Controls.Add(tv)
        sp.Panel2.Controls.Add(wb)

        pn1.Height = 30

        pn2.Controls.Add(pn1, 0, 0)
        pn2.Controls.Add(sp, 0, 1)

        tx.Text = "http://msdn2.microsoft.com/ja-jp/library/default(d=toc).aspx"

        bt2.Enabled = False

        Return pn2

    End Function


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Controls.Add(MyInitLayout())
        Me.Size = New Size(600, 500)

        wb.Url = New Uri(tx.Text)
    End Sub

    Public Class MyWeb : Inherits WebBrowser

    End Class
End Class



もう寝ます。
Script 注入して、ツリーの展開図だけを生成します。

削除パス：12345678