'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 &= "" str &= "" str &= "" str &= "" str &= "検索順位チェック" str &= "" str &= "" str &= "" str &= "

検索順位チェック

" str &= "YahooおよびGoogleの検索順位を調査します。
" str &= "
" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "" str &= "
キーワード1 指定URL1 
キーワード2 指定URL2 
キーワード3 指定URL3 
キーワード4 指定URL4 
キーワード5 指定URL5 
" str &= "
" str &= "" str &= "
" str &= "" str &= "" str &= "" 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("
(.*?)", 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("
(.*?)", 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("", "").Replace("", "").Replace("", "").Replace("", "") str = str.Replace("", "").Replace("", "").Replace("", "").Replace("", "") 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 &= "" str &= "" str &= "" str &= "" str &= "検索順位チェック" str &= "" str &= "" str &= "" str &= "

検索順位チェック

" str &= "YahooおよびGoogleの検索順位
" str &= "" str &= "" 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 &= "" Next str &= "
キーワードURLYahooGoogle
" & results(i).keyword & "" & results(i).url & "" & y & "" & g & "
" str &= "" str &= "" 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