このサイトも「googleペナルティ」を受けてしまったらしいです。「googleウェブマスターツール」
から「再審査をリクエスト」して数週間経過しました。まだgoogle様のお許しは頂けてないようです。

色々気になったのでSEO(検索エンジン最適化)ツールを作って時々チェックする事にしました。
今回作ったツールはサイト内ＵＲＬチェックです。

このツールのプログラミングは少々難しく、色々(ページランクの取得方法など)調べましたので、
その中の１つ(検索順位取得方法)のサンプルを公開します。このサンプルYahooやMSNにも応用出来ます。

サンプルソース中の「秘密のキーワード」の部分は公開して良いのか不安だったので秘密にさせてください。

関連情報
GoogleのPageRankを取得するサンプル(VB.NET)
GoogleのPageRank取得用のCheckSum(ch)を計算するサンプル(perl)
サイト内ＵＲＬチェック(VB.NET/C#.NET用DLL)
サイト内ＵＲＬチェック(ツール)

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

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