| ■7384 / ) |
Re[16]: MSDNの目次が欲しい |
□投稿者/ ｍあ (56回)-(2007/09/05(Wed) 02:12:21)
|
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
|
|
