サイトロジー2 自動ブラウザ

サンプルコード009
検索順位チェック
※コードは開発当時の物で、既に機能しない可能性もあります。
YahooとGoogleで指定したキーワードでの検索順位を調査します。
※おそらくGoogle側の仕様変更によりGoogleの検索順位は正しく表示されません。
プログラムコード記述の参考になれば幸いです。
---------------------------------------------------------------
≫ ダウンロード(c2検索順位チェック1.txt)
'CYTOLOGY2 検索順位チェック 20130421
'---------------------------------------------------------------

Imports System.Drawing
Imports System.Windows.Forms
Imports Microsoft.VisualBasic

Public Class AddIn

    Private Const APPNAME As String = "検索順位チェック"
    Private Const MAXRANK As Integer = 100
    Private tabb As TabBrowser
    Private std As Std
    Private stdf As StdFunc
    Private ddLabelNow As ToolStripLabel

    Private results(5 - 1) As resultsValue
    Private resultsNum As Integer = 0

    Private busyNavigate As Boolean

    Private p_keyword(5 - 1) As String
    Private p_url(5 - 1) As String

    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()
        results(0) = Nothing
        results(1) = Nothing
        results(2) = Nothing
        results(3) = Nothing
        results(4) = Nothing
        std.AddInMenuRemove()
    End Sub

    Public Sub AddIn_Start()
        Dim dummy As String = ""
        Try
            dummy = tabb.WebBrowser.Document.GetElementById("p_keyword1").InnerHtml
        Catch ex As System.Exception
            startMessage()
            std.ExitAddIn()
            Exit Sub
        End Try
        If dummy = "" Then
            startMessage()
            std.ExitAddIn()
            Exit Sub
        End If
        p_keyword(0) = tabb.WebBrowser.Document.GetElementById("p_keyword1").InnerHtml
        p_url(0) = tabb.WebBrowser.Document.GetElementById("p_url1").InnerHtml
        p_keyword(1) = tabb.WebBrowser.Document.GetElementById("p_keyword2").InnerHtml
        p_url(1) = tabb.WebBrowser.Document.GetElementById("p_url2").InnerHtml
        p_keyword(2) = tabb.WebBrowser.Document.GetElementById("p_keyword3").InnerHtml
        p_url(2) = tabb.WebBrowser.Document.GetElementById("p_url3").InnerHtml
        p_keyword(3) = tabb.WebBrowser.Document.GetElementById("p_keyword4").InnerHtml
        p_url(3) = tabb.WebBrowser.Document.GetElementById("p_url4").InnerHtml
        p_keyword(4) = tabb.WebBrowser.Document.GetElementById("p_keyword5").InnerHtml
        p_url(4) = tabb.WebBrowser.Document.GetElementById("p_url5").InnerHtml
        ddButtonInitial01()
        info("順位調査実行", Color.Blue)

        results(0) = New resultsValue()
        results(1) = New resultsValue()
        results(2) = New resultsValue()
        results(3) = New resultsValue()
        results(4) = New resultsValue()

        searchExec()    'Google,Yahoo順位調査を実行
        drawResult()
        std.ExitAddIn()
    End Sub

    Private Sub ddButtonInitial01()
        ddLabelNow = New ToolStripLabel("停止中")
        ddLabelNow.ForeColor = Color.Black
        std.AddInMenuAddOnce(ddLabelNow)
    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 infoCountdown(ByVal str As String, ByVal c As Color, ByVal num As Integer)
        For i As Integer = num To 1 Step -1
            info(str & " " & i.ToString, c)
            stdf.WaitMilliSec(1000)
        Next
        info(str & " 0", c)
    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>検索順位チェック</title>"
        str &= "<style>"
        str &= "table {"
        str &= "border-collapse: collapse;"
        str &= "font-size: 12px;"
        str &= "line-height: 1.5em;"
        str &= "color: #333;"
        str &= "margin: 10px 0 0 0;"
        str &= "}"
        str &= "table tr th {"
        str &= "background-color: #eee;"
        str &= "border: solid 1px #aaa;"
        str &= "padding: 1px 5px;"
        str &= "font-weight: normal;"
        str &= "text-align: left;"
        str &= "}"
        str &= "table tr td {"
        str &= "border: solid 1px #aaa;"
        str &= "padding: 1px 5px;"
        str &= "}"
        str &= "#result {"
        str &= "font-size: 12px;"
        str &= "line-height: 1.5em;"
        str &= "color: #a00;"
        str &= "margin: 10px 0 0 0;"
        str &= "}"
        str &= "#p_keyword1,#p_url1"
        str &= ",#p_keyword2,#p_url2"
        str &= ",#p_keyword3,#p_url3"
        str &= ",#p_keyword4,#p_url4"
        str &= ",#p_keyword5,#p_url5"
        str &= ",#p_starthour,#p_endhour,#p_starttime"
        str &= ",#p_imgholder"
        str &= ",#p_uapc,#p_uatb,#p_uasp"
        str &= ",#p_mailhost,#p_mailid,#p_mailpw {"
        str &= "font-size: 12px;"
        str &= "line-height: 1.5em;"
        str &= "color: #a00;"
        str &= "}"
        str &= "</style>"
        str &= "</head>"
        str &= "<body>"
        str &= "<h2>検索順位チェック</h2>"
        str &= "YahooおよびGoogleの検索順位を調査します。<br>"
        str &= "<form>"
        str &= "<table>"
        str &= "<tr>"
        str &= "<th>キーワード1</th><td><input type=""text"" size=""25"" id=""keyword1"" value=""""> <span id=""p_keyword1""></span></td>"
        str &= "<th>指定URL1</th><td><input type=""text"" size=""35"" id=""url1"" value=""""> <span id=""p_url1""></span></td>"
        str &= "</tr>"
        str &= "<tr>"
        str &= "<th>キーワード2</th><td><input type=""text"" size=""25"" id=""keyword2"" value=""""> <span id=""p_keyword2""></span></td>"
        str &= "<th>指定URL2</th><td><input type=""text"" size=""35"" id=""url2"" value=""""> <span id=""p_url2""></span></td>"
        str &= "</tr>"
        str &= "<tr>"
        str &= "<th>キーワード3</th><td><input type=""text"" size=""25"" id=""keyword3"" value=""""> <span id=""p_keyword3""></span></td>"
        str &= "<th>指定URL3</th><td><input type=""text"" size=""35"" id=""url3"" value=""""> <span id=""p_url3""></span></td>"
        str &= "</tr>"
        str &= "<tr>"
        str &= "<th>キーワード4</th><td><input type=""text"" size=""25"" id=""keyword4"" value=""""> <span id=""p_keyword4""></span></td>"
        str &= "<th>指定URL4</th><td><input type=""text"" size=""35"" id=""url4"" value=""""> <span id=""p_url4""></span></td>"
        str &= "</tr>"
        str &= "<tr>"
        str &= "<th>キーワード5</th><td><input type=""text"" size=""25"" id=""keyword5"" value=""""> <span id=""p_keyword5""></span></td>"
        str &= "<th>指定URL5</th><td><input type=""text"" size=""35"" id=""url5"" value=""""> <span id=""p_url5""></span></td>"
        str &= "</tr>"
        str &= "</table>"
        str &= "</form>"
        str &= "<button id=""chk"">確認</button>"
        str &= "<div id=""result""></div>"
        str &= "<script>"
        str &= "(function (window) {"
        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 safety_str(str) {"
        str &= "replaceAll(str,'<','<');"
        str &= "replaceAll(str,'>','>');"
        str &= "return str;"
        str &= "}"
        str &= "function replaceAll(expression, org, dest) {"
        str &= "return expression.split(org).join(dest);"
        str &= "}"
        str &= "function chk() {"
        str &= "document.getElementById('p_keyword1').innerHTML = safety_str(document.getElementById('keyword1').value);"
        str &= "document.getElementById('p_keyword2').innerHTML = safety_str(document.getElementById('keyword2').value);"
        str &= "document.getElementById('p_keyword3').innerHTML = safety_str(document.getElementById('keyword3').value);"
        str &= "document.getElementById('p_keyword4').innerHTML = safety_str(document.getElementById('keyword4').value);"
        str &= "document.getElementById('p_keyword5').innerHTML = safety_str(document.getElementById('keyword5').value);"
        str &= "document.getElementById('p_url1').innerHTML = safety_str(document.getElementById('url1').value);"
        str &= "document.getElementById('p_url2').innerHTML = safety_str(document.getElementById('url2').value);"
        str &= "document.getElementById('p_url3').innerHTML = safety_str(document.getElementById('url3').value);"
        str &= "document.getElementById('p_url4').innerHTML = safety_str(document.getElementById('url4').value);"
        str &= "document.getElementById('p_url5').innerHTML = safety_str(document.getElementById('url5').value);"
        str &= "if (document.getElementById('p_keyword2').innerHTML != '' && document.getElementById('p_url2').innerHTML == '') { document.getElementById('p_url2').innerHTML = document.getElementById('p_url1').innerHTML; }"
        str &= "if (document.getElementById('p_keyword3').innerHTML != '' && document.getElementById('p_url3').innerHTML == '') { document.getElementById('p_url3').innerHTML = document.getElementById('p_url1').innerHTML; }"
        str &= "if (document.getElementById('p_keyword4').innerHTML != '' && document.getElementById('p_url4').innerHTML == '') { document.getElementById('p_url4').innerHTML = document.getElementById('p_url1').innerHTML; }"
        str &= "if (document.getElementById('p_keyword5').innerHTML != '' && document.getElementById('p_url5').innerHTML == '') { document.getElementById('p_url5').innerHTML = document.getElementById('p_url1').innerHTML; }"
        str &= "document.getElementById('result').innerHTML = '表示された赤文字の内容で処理を行います。よろしければ実行ボタンを押します。<br>'"
        str &= "+ '修正する場合は入力値を直して確認ボタンを押して下さい';"
        str &= "}"
        str &= "})(window);"
        str &= "</script>"
        str &= "</body>"
        str &= "</html>"
        tabb.WebBrowser.DocumentText = str
    End Sub

    Private Sub searchExec()
        'resultsクラスに現在調査中データを保管
        For kw As Integer = 0 To 4 Step 1
            If p_keyword(kw) = "" OrElse p_url(kw) = "" Then
                Continue For
            End If
            resultsNum = kw
            results(resultsNum).keyword = p_keyword(kw)
            results(resultsNum).url = p_url(kw)

            info("yahoo:" & results(resultsNum).keyword, Color.Blue)
            yahoo()
            info("google:" & results(resultsNum).keyword, Color.Blue)
            google()
            If std.StopFlag Then Exit For
        Next
    End Sub

    Private Sub yahoo()
        For i As Integer = 1 To (MAXRANK + 1) Step 10
            busyNavigate = True
            tabb.DocumentCompletedEventRemove(AddressOf yahoo2)
            tabb.DocumentCompletedEventAdd(AddressOf yahoo2)
            tabb.Navigate("http://search.yahoo.co.jp/search?p=" & System.Uri.EscapeUriString(results(resultsNum).keyword) & "&ei=UTF-8&n=10&b=" & i.ToString)
            For i2 As Integer = 0 To 75 Step 1
                stdf.WaitMilliSec(400)
                If busyNavigate = False Then    '処理が終わるまで待つ
                    Exit For
                End If
            Next
            If busyNavigate = True Then
                yahoo2(Nothing, Nothing)
            End If
            If results(resultsNum).yahooRanking <> -1 Then
                results(resultsNum).yahooRanking = results(resultsNum).yahooRanking + (i - 1)
                Exit For
            End If
        Next
    End Sub
    Private Sub google()
        For i As Integer = 0 To MAXRANK Step 10
            busyNavigate = True
            tabb.DocumentCompletedEventRemove(AddressOf google2)
            tabb.DocumentCompletedEventAdd(AddressOf google2)
            tabb.Navigate("http://www.google.co.jp/search?hl=ja&q=" & System.Uri.EscapeUriString(results(resultsNum).keyword) & "&cad=h&pws=0&start=" & i.ToString)
            For i2 As Integer = 0 To 75 Step 1
                stdf.WaitMilliSec(400)
                If busyNavigate = False Then    '処理が終わるまで待つ
                    Exit For
                End If
            Next
            If busyNavigate = True Then
                google2(Nothing, Nothing)
            End If
            If results(resultsNum).googleRanking <> -1 Then
                results(resultsNum).googleRanking = results(resultsNum).googleRanking + i
                Exit For
            End If
        Next
    End Sub

    Private Sub yahoo2(ByVal sender As Object, ByVal e As System.EventArgs)
        tabb.DocumentCompletedEventRemove(AddressOf yahoo2)
        Dim r1 As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex("<div class=""a""><span class=""u"">(.*?)</span>", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Singleline)
        Dim m1 As System.Text.RegularExpressions.Match = r1.Match(tabb.WebBrowser.DocumentText)
        Dim c As Integer = 1
        Do While m1.Success
            If trimB(m1.Groups(1).Value).IndexOf(results(resultsNum).url) <> -1 Then
                results(resultsNum).yahooRanking = c
                Exit Do
            End If
            m1 = m1.NextMatch()
            c += 1
        Loop
        busyNavigate = False
    End Sub

    Private Sub google2(ByVal sender As Object, ByVal e As System.EventArgs)
        tabb.DocumentCompletedEventRemove(AddressOf google2)
        Dim r1 As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex("<div class=""f kv""><cite>(.*?)</cite>", System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.Singleline)
        Dim m1 As System.Text.RegularExpressions.Match = r1.Match(tabb.WebBrowser.DocumentText)
        Dim c As Integer = 1
        Do While m1.Success
            If trimB(m1.Groups(1).Value).IndexOf(results(resultsNum).url) <> -1 Then
                results(resultsNum).googleRanking = c
                Exit Do
            End If
            m1 = m1.NextMatch()
            c += 1
        Loop
        busyNavigate = False
    End Sub

    Private Function trimB(ByVal str As String) As String
        str = str.Replace("<b>", "").Replace("</b>", "").Replace("<B>", "").Replace("</B>", "")
        str = str.Replace("<em>", "").Replace("</em>", "").Replace("<EM>", "").Replace("</EM>", "")
        str = str.Replace(Microsoft.VisualBasic.ChrW(13), "").Replace(Microsoft.VisualBasic.ChrW(10), "")
        Return str.Trim
    End Function

    Private Sub drawResult()
        tabb.TabText = APPNAME
        Dim str As String = ""
        str &= "<!doctype html>"
        str &= "<html lang=""ja"">"
        str &= "<head>"
        str &= "<meta charset=""utf-8"">"
        str &= "<title>検索順位チェック</title>"
        str &= "<style>"
        str &= "table {"
        str &= "border-collapse: collapse;"
        str &= "font-size: 12px;"
        str &= "line-height: 1.5em;"
        str &= "color: #333;"
        str &= "margin: 10px 0 0 0;"
        str &= "}"
        str &= "table tr th {"
        str &= "background-color: #eee;"
        str &= "border: solid 1px #aaa;"
        str &= "padding: 1px 5px;"
        str &= "font-weight: normal;"
        str &= "text-align: left;"
        str &= "}"
        str &= "table tr td {"
        str &= "border: solid 1px #aaa;"
        str &= "padding: 1px 5px;"
        str &= "}"
        str &= "table tr td span {"
        str &= "background-color: yellow;"
        str &= "}"
        str &= "</style>"
        str &= "</head>"
        str &= "<body>"
        str &= "<h2>検索順位チェック</h2>"
        str &= "YahooおよびGoogleの検索順位<br>"
        str &= "<table>"
        str &= "<tr><th>キーワード</td><th>URL</td><th>Yahoo</th><th>Google</th></tr>"
        For i As Integer = 0 To 4 Step 1
            If results(i).keyword = "" Then
                Continue For
            End If
            Dim y As String
            Dim g As String
            If results(i).yahooRanking <> -1 Then
                y = results(i).yahooRanking.ToString
            Else
                y = "(" & MAXRANK.ToString & "位以上)"
            End If
            If results(i).googleRanking <> -1 Then
                g = results(i).googleRanking.ToString
            Else
                g = "(" & MAXRANK.ToString & "位以上)"
            End If
            str &= "<tr><td>" & results(i).keyword & "</td><td>" & results(i).url & "</td><td>" & y & "</td><td>" & g & "</td></tr>"
        Next
        str &= "</table>"
        str &= "</body>"
        str &= "</html>"
        tabb.WebBrowser.DocumentText = str
    End Sub

End Class

Public Class resultsValue
    Private e_keyword As String
    Private e_url As String
    Private e_yahooRanking As Integer
    Private e_googleRanking As Integer

    Public Sub New()
        e_keyword = ""
        e_url = ""
        e_yahooRanking = -1
        e_googleRanking = -1
    End Sub

    Public Property keyword() As String
        Get
            Return e_keyword
        End Get
        Set(value As String)
            e_keyword = value
        End Set
    End Property
    Public Property url() As String
        Get
            Return e_url
        End Get
        Set(value As String)
            e_url = value
        End Set
    End Property

    Public Property yahooRanking() As Integer
        Get
            Return e_yahooRanking
        End Get
        Set(value As Integer)
            e_yahooRanking = value
        End Set
    End Property
    Public Property googleRanking() As Integer
        Get
            Return e_googleRanking
        End Get
        Set(value As Integer)
            e_googleRanking = value
        End Set
    End Property

End Class
動画

画像

アイコン

文字列

QRコード

Excel

SVG

読み上げ

HTML,CSS

色

3D

音

ビット、バイト

データベース

カレンダー系

IPv4,IPv6

インターネット

開発

ビンゴ大会開催システム(Wタイプ) 自動更新

ビンゴ(Pタイプ) 自動更新

ビンゴ(Aタイプ) 抽選機+カード

ビンゴ(Mタイプ) 手動更新

抽選機等

パズル、ゲーム

他
