サンプルコード006
HomepageBuilder作成ページ検索
Yahooの検索結果から、METAタグGENERATORに Homepage Builder が含まれるサイトをリストアップします。
結果表示後に新規Excelファイルへ書き出す事が可能です。

用途:
「HomepageBuilderで作成されているサイト = プロが手掛けたものではない」という
前提で考えると、Web屋さんにとっては営業先になりうるのではないかと考えました。
'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
 
 
 
 
このサイトでお気付きの点がございましたら
ご連絡いただけますと幸いです。
Eメール(任意)
送信内容
 
このサイトでお気付きの点がございましたら
ご連絡いただけますと幸いです。
 
Eメール(任意)
送信内容
 
このサイトでお気付きの点がございましたら
ご連絡いただけますと幸いです。
 
Eメール(任意)
送信内容
 
便




top of page