'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コード
便利ウェブサイト
便利 Android アプリ
便利 iOS(iPhone,iPad) アプリ
