|
Googleの検索順位を取得するサンプル(VB.NET)
|
このサイトも「googleペナルティ」を受けてしまったらしいです。「googleウェブマスターツール」から
「再審査をリクエスト」して数週間経過しました。まだgoogle様のお許しは頂けてないようです。
色々気になったのでSEO(検索エンジン最適化)ツールを作って時々チェックする事にしました。
今回作ったツールはサイト内ＵＲＬチェックです。
このツールのプログラミングは少々難しく、色々(ページランクの取得方法など)調べましたので、
その中の１つ(検索順位取得方法)のサンプルを公開します。このサンプルYahooやMSNにも応用出来ます。
サンプルソース中の「秘密のキーワード」の部分は公開して良いのか不安だったので秘密にさせてください。
関連情報
GoogleのPageRankを取得するサンプル(VB.NET)
GoogleのPageRank取得用のCheckSum(ch)を計算するサンプル(perl)
サイト内ＵＲＬチェック(ツール)
CheckUrlRank(ツール)
★標準モジュール(Module1.vb)
Imports System.IO
Imports System.Net
Module Module1
''' <summary>
''' Google検索順位取得
''' </summary>
''' <param name="Url">Google検索用URL(クエリ)</param>
''' <remarks></remarks>
Public Function GetUrlRank(ByVal url As String) As String()
Dim p1 As Integer
Dim p2 As Integer
Dim p1_1 As Integer
Dim p1_2 As Integer
Dim p1_3 As Integer
Dim p2_1 As Integer
Dim p2_2 As Integer
Dim dat As Byte() = GetWebPage(url)
Dim html As String = System.Text.Encoding.GetEncoding("UTF-8").GetString(dat)
Dim url_ary As String() = New String(-1) {}
Dim stp As Integer = 0
Do
p1 = html.IndexOf("<", stp)
If p1 >= 0 Then
p2 = html.IndexOf(">", stp)
If p2 >= 0 And p2 > p1 Then
stp = p2 + 1
Dim tag As String = "<" & html.Substring(p1 + 1, p2 - p1 - 1).Trim & ">"
Dim ref As String = ""
p1_1 = tag.ToLower.IndexOf("<" & "a")
If p1_1 >= 0 Then
p1_2 = tag.ToLower.IndexOf("href", p1_1)
p1_3 = tag.ToLower.IndexOf(">", p1_1)
If p1_3 < 0 Then p1_3 = p1_2 + 1
If p1_2 >= 0 And p1_2 > p1_1 And p1_2 < p1_3 Then
p1_1 = p1_2
If p1_1 >= 0 Then
p1_1 = p1_1 + "href".Length
ref = tag.Substring(p1_1)
ref = ref.TrimStart(New Char() {" "})
If ref.Substring(0, 1) <> "=" Then
ref = ""
End If
ref = ref.TrimStart(New Char() {"=", " ", "'", """"})
p2_1 = ref.IndexOf("""")
p2_2 = ref.IndexOf("'")
If p2_2 >= 0 And p2_1 > p2_2 Then p2_1 = p2_2
p2_2 = ref.IndexOf(">")
If p2_2 >= 0 And p2_1 > p2_2 Then p2_1 = p2_2
If p2_1 >= 0 Then
ref = ref.Substring(0, p2_1).Trim
Else
ref = ""
End If
End If
End If
End If
If ref <> "" Then
If tag.IndexOf("秘密のキーワード") >= 0 Then
ReDim Preserve url_ary(UBound(url_ary) + 1)
url_ary(UBound(url_ary)) = ref
End If
End If
Else
stp = p1
End If
Else
Exit Do
End If
Application.DoEvents()
Loop
Return url_ary
End Function
''' <summary>
''' Google検索順位Webページ取得
''' </summary>
''' <param name="url">Google検索用URL(クエリ)</param>
''' <returns>Google検索順位Webページ</returns>
''' <remarks></remarks>
Public Function GetWebPage(ByVal url As String) As Byte()
Dim st As Stream = Nothing
Dim wbres As WebResponse = Nothing
Try
Dim url_uri As New Uri(url)
Dim dat As Byte() = New Byte(-1) {}
Dim wbreq As WebRequest = CType(WebRequest.Create(url), HttpWebRequest)
CType(wbreq, HttpWebRequest).UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows XP)"
CType(wbreq, HttpWebRequest).Headers.Add("Accept-Language", "ja")
wbres = wbreq.GetResponse()
st = wbres.GetResponseStream()
Dim bytes As Byte()
Dim ttlSiz As Integer = 0
Dim oneSiz As Integer
Do
ReDim bytes((1024 * 100) - 1)
oneSiz = st.Read(bytes, 0, bytes.Length)
If oneSiz > 0 Then
ReDim Preserve dat(ttlSiz + oneSiz - 1)
If oneSiz <> bytes.Length Then
ReDim Preserve bytes(oneSiz - 1)
End If
bytes.CopyTo(dat, ttlSiz)
ttlSiz = ttlSiz + oneSiz
End If
Loop While (oneSiz > 0)
Return dat
Catch ex As Exception
Throw ex
Finally
If st Is Nothing = False Then
st.Close()
st = Nothing
End If
If wbres Is Nothing = False Then
wbres.Close()
wbres = Nothing
End If
End Try
End Function
End Module
★フォームモジュール(Form1.vb)
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim key = "NonSoft"
Dim url As String = "http://www.google.com/search?&q=" & key
Dim urls As String() = GetUrlRank(url)
Dim msg As String = ""
If UBound(urls) >= 0 Then
Process.Start(url)
Application.DoEvents()
Threading.Thread.Sleep(1000)
For i As Integer = 0 To UBound(urls)
msg = msg & urls(i) & vbCrLf
Next
MessageBox.Show("googleの検索結果は以下の通りです。" & vbCrLf & vbCrLf & msg, "googleの検索結果は以下の通りです。")
Else
MessageBox.Show("googleの検索結果は見つかりませんでした。", "googleの検索結果は以下の通りです。")
End If
End Sub
End Class