'CYTOLOGY2 HomepageBuilder作成ページ検索 20130226
'---------------------------------------------------------------
'Copyright(C) 2013 ao-system エーオーシステム
'licensed under the LGPL
'ライセンスはLGPLに準じたものになります。詳しくは下記サイトを参照下さい。
'https://ao-system.net/cytology2/
'LGPLに準じ、この著作権表示は消去できません。
'---------------------------------------------------------------
'
'HomePageBuilderで作成されたサイトを検索。
'Yahooの検索結果から、METAタグGENERATORに Homepage Builder が含まれるサイトをリストアップします。
'結果表示後に新規Excelファイルへ書き出す事が可能です。
'
'---------------------------------------------------------------
Imports System.Drawing
Imports System.Windows.Forms
Public Class AddIn
Private Const APPNAME As String = "HomepageBuilder作成ページ検索"
Private tabb As TabBrowser
Private std As Std
Private stdf As StdFunc
Private ddLabelNow As ToolStripLabel
Private urlList(1000) As String
Private urlListIndex As Integer
Private findList(1000) As String
Private findListIndex As Integer
Private findTitle(1000) As String
Private busyNavigate As Boolean
Private searchWord As String
Private searchFrom As Integer
Private searchTo As Integer
Public Sub New()
tabb = New TabBrowser()
std = New Std()
stdf = New StdFunc()
End Sub
Public Sub AddIn_Load()
startMessage()
End Sub
Public Sub AddIn_Stop()
std.AddInMenuRemove()
End Sub
Public Sub AddIn_Start()
searchWord = tabb.WebBrowser.Document.GetElementById("inputsearchword").InnerHtml
searchFrom = stdf.IntVal(tabb.WebBrowser.Document.GetElementById("inputsearchfrom").InnerHtml)
searchTo = stdf.IntVal(tabb.WebBrowser.Document.GetElementById("inputsearchto").InnerHtml)
ddButtonInitial01()
ysearch()
urlMessage()
homepagebuilderSearch()
findMessage()
excelOut()
std.ExitAddIn()
End Sub
Private Sub info(ByVal str As String, ByVal c As Color)
If std.StopFlag Then Exit Sub
ddLabelNow.Text = str
ddLabelNow.ForeColor = c
Application.DoEvents()
End Sub
Private Sub ddButtonInitial01()
ddLabelNow = New ToolStripLabel("停止中")
ddLabelNow.ForeColor = Color.Black
std.AddInMenuAddOnce(ddLabelNow)
End Sub
Private Sub startMessage()
tabb.TabText = APPNAME
Dim str As String = ""
str &= "<!doctype html>"
str &= "<html lang=""ja"">"
str &= "<head>"
str &= "<meta charset=""utf-8"">"
str &= "<title>HomePageBuilderで作成されたサイトを検索</title>"
str &= "<style>"
str &= "table {"
str &= "border-collapse: collapse;"
str &= "font-size: 12px;"
str &= "line-height: 1.5em;"
str &= "color: #333;"
str &= "margin: 20px 0 0 0;"
str &= "}"
str &= "table tr th {"
str &= "background-color: #eee;"
str &= "border: solid 1px #aaa;"
str &= "padding: 3px 5px;"
str &= "font-weight: normal;"
str &= "}"
str &= "table tr td {"
str &= "border: solid 1px #aaa;"
str &= "padding: 3px 5px;"
str &= "}"
str &= "table tr td div {"
str &= "color: #a00;"
str &= "}"
str &= "#searchfrom,#searchto {"
str &= "ime-mode: disabled;"
str &= "}"
str &= "#result {"
str &= "font-size: 12px;"
str &= "line-height: 1.5em;"
str &= "color: #a00;"
str &= "margin: 10px 0 0 0;"
str &= "}"
str &= "#note {"
str &= "font-size: 12px;"
str &= "line-height: 1.5em;"
str &= "color: #333;"
str &= "border: dashed 1px #aaa;"
str &= "margin: 20px 0 0 0;"
str &= "padding: 10px;"
str &= "}"
str &= "</style>"
str &= "</head>"
str &= "<body>"
str &= "<h2>HomePageBuilderで作成されたサイトを検索</h2>"
str &= "<div>Yahooの検索結果から、METAタグGENERATORに Homepage Builder が含まれるサイトをリストアップします。<br>"
str &= "結果表示後に新規Excelファイルへ書き出す事が可能です。"
str &= "</div>"
str &= "<form>"
str &= "<table>"
str &= "<tr>"
str &= "<th>検索語句</th><th>検索開始ページ</th><th>検索終了ページ</th>"
str &= "</tr>"
str &= "<tr>"
str &= "<td><input type=""text"" size=""20"" id=""searchword""></td>"
str &= "<td><input type=""number"" size=""10"" id=""searchfrom""></td>"
str &= "<td><input type=""number"" size=""10"" id=""searchto""></td>"
str &= "</tr>"
str &= "<tr>"
str &= "<td>Yahoo検索ワード<br>例) 浜松<br>例) 浜松 工業<br>例) 東京 不動産</td>"
str &= "<td>ページ番号<br>(1ページ100件)<br>1から10の整数</td>"
str &= "<td>ページ番号<br>(1ページ100件)<br>1から10の整数</td>"
str &= "</tr>"
str &= "<tr>"
str &= "<td><div id=""inputsearchword""> </div></td>"
str &= "<td><div id=""inputsearchfrom""></div></td>"
str &= "<td><div id=""inputsearchto""></div></td>"
str &= "</tr>"
str &= "</table>"
str &= "</form>"
str &= "<button id=""chk"">確認</button>"
str &= "<div id=""result""></div>"
str &= "<div id=""note"">まれに勝手に別窓を開くサイトが有りますので、メニューの「FILE」-「設定」のリンククリック時の新規ウインドウ処理を「全てIE起動」または「全て指定ブラウザ起動」にすることをお勧めします。<br>"
str &= "インターネットオプションの「詳細設定」でマルチメディア項目の「画像を表示しない」にすると速度が速くなります。<br>"
str &= "初めて使う場合は1ページ程の少ない指定で動作をご確認ください。"
str &= "</div>"
str &= "<script>"
str &= " (function (window) {"
str &= "addEvt(document.getElementById('searchword'),'blur',blurSearchWord);"
str &= "addEvt(document.getElementById('searchfrom'),'blur',blurSearchFrom);"
str &= "addEvt(document.getElementById('searchto'),'blur',blurSearchTo);"
str &= "addEvt(document.getElementById('chk'),'click',chk);"
str &= "function addEvt(elm, tpe, func) {"
str &= "if (elm.addEventListener) {"
str &= "return elm.addEventListener(tpe, func, false);"
str &= "} else if (elm.attachEvent) {"
str &= "return elm.attachEvent('on' + tpe, func);"
str &= "} else {"
str &= "return elm['on' + tpe] = func;"
str &= "}"
str &= "}"
str &= "function blurSearchWord() {"
str &= "document.getElementById('inputsearchword').innerHTML = document.getElementById('searchword').value;"
str &= "}"
str &= "function blurSearchFrom() {"
str &= "var num = parseInt(document.getElementById('searchfrom').value);"
str &= "if (num < 1) { num = 1; }"
str &= "document.getElementById('inputsearchfrom').innerHTML = num;"
str &= "}"
str &= "function blurSearchTo() {"
str &= "var num = parseInt(document.getElementById('searchto').value);"
str &= "if (num > 10) { num = 10; }"
str &= "document.getElementById('inputsearchto').innerHTML = num;"
str &= "}"
str &= "function chk() {"
str &= "blurSearchWord();"
str &= "blurSearchFrom();"
str &= "blurSearchTo();"
str &= "var f = document.getElementById('inputsearchfrom').innerHTML;"
str &= "var t = document.getElementById('inputsearchto').innerHTML;"
str &= "document.getElementById('result').innerHTML = 'Yahoo検索で「'"
str &= "+ document.getElementById('inputsearchword').innerHTML + '」と言うキーワードにて「'"
str &= "+ f + 'ページ目(' + ((f - 1) * 100 + 1) + '位)」から「'"
str &= "+ t + 'ページ目(' + (t * 100) + '位)」までを検索して、HomepageBuilderで作成されているサイトをリストアップします。<br>実行ボタンで開始します。'"
str &= "}"
str &= "})(window);"
str &= " </script>"
str &= "</body>"
str &= "</html>"
tabb.WebBrowser.DocumentText = str
End Sub
Private Sub ysearch()
urlListIndex = 0
For i As Integer = searchFrom - 1 To searchTo - 1 Step 1
busyNavigate = True
tabb.Navigate("http://search.yahoo.co.jp/search?p=" & System.Uri.EscapeUriString(searchWord) & "&ei=UTF-8&n=100&b=" & (i * 100 + 1).ToString)
tabb.DocumentCompletedEventAdd(AddressOf ysearch2)
stdf.WaitMilliSec(500)
For i2 As Integer = 0 To 30 Step 1
If busyNavigate = False Then
Exit For
End If
stdf.WaitMilliSec(1000)
Next
If std.StopFlag Then Exit For
Next
End Sub
Private Sub ysearch2(ByVal sender As Object, ByVal e As System.EventArgs)
tabb.DocumentCompletedEventRemove(AddressOf ysearch2)
Dim elems As HtmlElementCollection = tabb.WebBrowser.Document.GetElementsByTagName("H3")
For Each elm As HtmlElement In elems
If elm.InnerHtml.StartsWith("<A") Then
Dim url As String = elm.All.Item(0).GetAttribute("href")
setUrlList(url)
info("URL(" & urlListIndex.ToString & "): " & url, Color.Blue)
End If
If std.StopFlag Then Exit For
Next
busyNavigate = False
End Sub
Private Sub setUrlList(ByVal url As String)
Dim skipExt As String() = New String() {
".xls" _
, ".xlsx" _
, ".doc" _
, ".docx" _
, ".pdf" _
, ".php" _
, ".txt" _
, ".asp" _
, ".aspx" _
, ".swf" _
}
Dim skipUrl As String() = New String() { _
".2ch.net" _
, ".ameba.jp" _
, ".apple.com" _
, ".apamanshop.com" _
, ".aeonnet.co.jp" _
, ".asahi.com" _
, ".amazon.co.jp" _
, ".biglobe.ne.jp" _
, ".blogspot.jp" _
, ".blogmura.com" _
, ".chunichi.co.jp" _
, ".crooz.jp" _
, ".cocolog-nifty.com" _
, ".doko.jp" _
, ".excite.co.jp" _
, ".exblog.jp" _
, ".ekiten.jp" _
, ".facebook.com" _
, ".flickr.com" _
, ".fc2.com" _
, ".goo.ne.jp" _
, ".google.co.jp" _
, "/gnavi.co.jp" _
, ".gnavi.co.jp" _
, ".hamazo.tv" _
, ".hatena.ne.jp" _
, ".hotpepper.jp" _
, ".its-mo.net" _
, ".jugem.jp" _
, ".jma.go.jp" _
, ".jorudan.co.jp" _
, ".livedoor.com" _
, ".livedoor.jp" _
, ".mapion.co.jp" _
, ".nta.go.jp" _
, ".nta.co.jp" _
, ".nifty.com" _
, ".nikkan.co.jp" _
, ".ninja.co.jp" _
, "blog.ocn.ne.jp" _
, "/publicmap.jp" _
, ".rakuten.co.jp" _
, ".shizuoka.jp" _
, ".seesaa.jp" _
, ".seesaa.net" _
, ".sanaru.org" _
, ".so-net.ne.jp" _
, "/suumo.jp" _
, ".suumo.jp" _
, ".shizuoka.jp" _
, ".twitter.com" _
, "/tenki.jp" _
, "/tabelog.com" _
, ".tabelog.com" _
, ".travel.co.jp" _
, ".talentblog.jp" _
, ".teacup.com" _
, ".wikipedia.org" _
, ".weblio.jp" _
, ".yahoo.co.jp" _
, ".yaplog.jp" _
, ".yomiuri.co.jp" _
, ".yu-bin.net" _
, ".youtube.com" _
, ".asp?" _
, ".asp#" _
, ".aspx?" _
, ".aspx#" _
, ".php?" _
, ".php#" _
, ".xls?" _
, ".xls#" _
, ".xlsx?" _
, ".xlsx#" _
, ".doc?" _
, ".doc#" _
, ".docx?" _
, ".docx#" _
, ".pdf?" _
, ".pdf#" _
, ".txt?" _
, ".txt#" _
, ".swf?" _
, ".swf#" _
}
Dim url2 As String = url.ToLower
For i As Integer = 0 To skipExt.Length - 1 Step 1
If url2.EndsWith(skipExt(i)) Then
Exit Sub
End If
Next
For i As Integer = 0 To skipUrl.Length - 1 Step 1
If url2.IndexOf(skipUrl(i)) > 0 Then
Exit Sub
End If
Next
For i As Integer = 0 To urlListIndex - 1 Step 1
If urlList(i) = url Then
Exit Sub
End If
Next
urlList(urlListIndex) = url
urlListIndex += 1
End Sub
Private Sub urlMessage()
tabb.TabText = APPNAME
Dim str As String = ""
str &= "<!doctype html><html lang=""ja""><head><meta charset=""utf-8""><title>URL抽出結果</title></head>"
str &= "<body>"
str &= "<h2>URL抽出結果</h2>"
For i As Integer = 0 To urlListIndex - 1 Step 1
str &= urlList(i) & "<br>"
Next
str &= "</body></html>"
tabb.WebBrowser.DocumentText = str
End Sub
Private Sub homepagebuilderSearch()
findListIndex = 0
For i As Integer = 0 To urlListIndex - 1 Step 1
info("Check: " & i.ToString & " / " & (urlListIndex - 1).ToString, Color.Blue)
busyNavigate = True
tabb.Navigate(urlList(i))
tabb.DocumentCompletedEventAdd(AddressOf homepagebuilderSearch2)
stdf.WaitMilliSec(500)
For i2 As Integer = 0 To 15 Step 1
If busyNavigate = False Then
Exit For
End If
stdf.WaitMilliSec(1000)
Next
tabb.WebBrowser.DocumentText = ""
If std.StopFlag Then Exit For
Next
End Sub
Private Sub homepagebuilderSearch2(ByVal sender As Object, ByVal e As System.EventArgs)
tabb.DocumentCompletedEventRemove(AddressOf homepagebuilderSearch2)
Dim elems As HtmlElementCollection = tabb.WebBrowser.Document.GetElementsByTagName("META")
Dim limitCount As Integer = 20
For Each elm As HtmlElement In elems
If elm.GetAttribute("name") = "GENERATOR" AndAlso elm.GetAttribute("content").IndexOf("Homepage Builder") > 0 Then
setFindList(tabb.WebBrowser.Url.ToString, tabb.WebBrowser.DocumentTitle)
info("Find(" & findListIndex.ToString & "): " & tabb.WebBrowser.Url.ToString, Color.Blue)
Exit For
End If
limitCount -= 1
If limitCount < 1 Then
Exit For
End If
If std.StopFlag Then Exit For
Next
busyNavigate = False
End Sub
Private Sub setFindList(ByVal url As String, ByVal title As String)
For i As Integer = 0 To findListIndex - 1 Step 1
If findList(i) = url Then
Exit Sub
End If
Next
findList(findListIndex) = url
findTitle(findListIndex) = title
findListIndex += 1
End Sub
Private Sub findMessage()
tabb.TabText = APPNAME
Dim str As String = ""
str &= "<!doctype html><html lang=""ja""><head><meta charset=""utf-8""><title>Homepage Builder検索結果</title></head>"
str &= "<body>"
str &= "<h2>Homepage Builder検索結果</h2>"
For i As Integer = 0 To findListIndex - 1 Step 1
str &= findTitle(i) & "," & findList(i) & "<br>"
Next
str &= "</body></html>"
tabb.WebBrowser.DocumentText = str
End Sub
Private Sub excelOut()
If MessageBox.Show("エクセルで出力しますか?", APPNAME, MessageBoxButtons.YesNo, MessageBoxIcon.Question) <> DialogResult.Yes Then
Exit Sub
End If
Dim sfd As New SaveFileDialog()
sfd.FileName = searchWord & ".xlsx"
sfd.InitialDirectory = "C:\"
sfd.Filter = "xlsx(*.xlsx)|*.xlsx|すべてのファイル(*.*)|*.*"
sfd.FilterIndex = 1
sfd.Title = "保存先のファイルを選択してください"
sfd.RestoreDirectory = True
sfd.OverwritePrompt = True
sfd.CheckPathExists = True
Do While True
If sfd.ShowDialog() = DialogResult.OK Then
Exit Do
End If
If MessageBox.Show("エクセル出力を続行しますか? 続行の場合はYes 中止の場合はNo", APPNAME, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.No Then
Exit Sub
End If
Loop
excelOutStart()
Dim es As ExcelSheet = New ExcelSheet()
es.SelectSheet(1)
For i As Integer = 0 To findListIndex - 1 Step 1
es.RangeFormat(1, i + 1, 2, i + 1, "@")
es.CellValue(1, i + 1, findTitle(i))
es.CellValue(2, i + 1, findList(i))
Next
es.Save(sfd.FileName)
es.Dispose()
excelOutEnd()
End Sub
Private Sub excelOutStart()
Dim str As String = ""
str &= "<!doctype html><html lang=""ja""><head><meta charset=""utf-8""><title>Homepage Builder検索結果</title></head>"
str &= "<body>"
str &= "<h2>Homepage Builder検索結果をエクセルファイルに出力しています。しばらくお待ちください...</h2>"
str &= "</body></html>"
tabb.WebBrowser.DocumentText = str
Application.DoEvents()
End Sub
Private Sub excelOutEnd()
Dim str As String = ""
str &= "<!doctype html><html lang=""ja""><head><meta charset=""utf-8""><title>Homepage Builder検索結果</title></head>"
str &= "<body>"
str &= "<h2>Homepage Builder検索結果をエクセルファイルに出力しました。全ての処理が終了しました。</h2>"
str &= "検索文字：" & searchWord & "<br>"
str &= "検索範囲：" & searchFrom & " から " & searchTo & " まで。100サイト単位<br>"
str &= "出力数：" & findListIndex.ToString & " 件<br>"
str &= "終了時刻：" & System.DateTime.Now & "<br>"
str &= "</body></html>"
tabb.WebBrowser.DocumentText = str
Application.DoEvents()
End Sub
End Class
このページのQRコード
便利ウェブサイト
便利 Android アプリ
便利 iOS(iPhone,iPad) アプリ
