NonSoft

サイトマップ(sitemap.xml)を作成する
サンプル(VB.NET)


 サンプル(ソース/コード)
指定のWebページ内の全てのリンク(URL)を取得しサイトマップ(sitemap.xml)を作成するサンプルです。
HTMLのA HREFタグを解析してリンク(URL)を取得し、サイト内のURLのみsitemap.xmlに出力しています。
sitemap.xmlのプライオリティ項目には暫定的に1.00から0.00までの値を設定しています。

<関連するDLL>
・サイト内URLチェック(VB.NET/C#.NET用DLL)
 サイト内(HTTPページ)の全てのURLを取得しリンク切れチェックやWEBページ保存をするDLLです。
 A HREFタグ以外のタグ(FROM、FRAME、IFRAME、IMG等)のURLも取得します。

<関連するツール>
・サイト内URLチェック
 指定ページ以下の全てのURLを一覧表示しリンク切れをチェックします。
 URL一覧出力、サイトマップ作成、Webページのダウンロードに対応しています。

<関連するサンプルソース>
・Webページ内の全リンク(URL)を取得するサンプル(VB.NET)

★標準モジュール(Module1.vb)
Imports System.IO
Imports System.Net

Module Module1
    ''' <summary>
    ''' 指定Webページ内の全てのリンクを取得
    ''' </summary>
    ''' <param name="url">指定WebページのURL</param>
    ''' <returns>ページ内のリンクのリスト(配列)</returns>
    ''' <remarks></remarks>
    Public Function GetUrlList(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

        ' Webページ取得
        Dim dat As Byte() = GetWebPage(url)
        ' SHIFT-JISのページの場合
        Dim html As String = System.Text.Encoding.GetEncoding("SHIFT-JIS").GetString(dat)

        ' Webページのタグ解析
        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 = ""

                    ' aタグ検索
                    p1_1 = tag.ToLower.IndexOf("<" & "a")
                    If p1_1 >= 0 Then
                        ' hrefタグ検索
                        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
                        ' 相対URLを絶対URLに変換
                        If ref.IndexOf("http://") < 0 And _
                           ref.IndexOf("https://") < 0 And _
                           ref.IndexOf("javaScript:") < 0 And _
                           ref.IndexOf("mailto:") < 0 Then
                            ref = url & ref
                        End If
                        ' ページ内のリンクのリスト(配列)追加
                        ReDim Preserve url_ary(UBound(url_ary) + 1)
                        url_ary(UBound(url_ary)) = ref
                    End If
                Else
                    stp = p1
                End If
            Else
                Exit Do
            End If
            Application.DoEvents()
        Loop

        ' 重複URLチェック
        For i As Integer = 0 To UBound(url_ary) - 1
            For j As Integer = i + 1 To UBound(url_ary)
                If url_ary(i) = url_ary(j) Then
                    url_ary(j) = ""
                End If
            Next
        Next

        ' 重複URL削除
        Dim url_ary2 As String() = New String(-1) {}
        For i As Integer = 0 To UBound(url_ary) - 1
            If url_ary(i) <> "" Then
                ReDim Preserve url_ary2(UBound(url_ary2) + 1)
                url_ary2(UBound(url_ary2)) = url_ary(i)
            End If
        Next

        ' URLソート
        Array.Sort(url_ary2)

        Return url_ary2
    End Function

    ''' <summary>
    ''' Webページ取得
    ''' </summary>
    ''' <param name="url">Webページ取得用URL</param>
    ''' <returns>WebページのByte配列データ</returns>
    ''' <remarks></remarks>
    Private Function GetWebPage(ByVal url As String) As Byte()
        Dim st As Stream = Nothing
        Dim wbres As WebResponse = Nothing
        Try
            ' URI設定
            Dim url_uri As New Uri(url)

            ' Webリクエスト
            Dim wbreq As WebRequest = CType(WebRequest.Create(url), HttpWebRequest)
            ' HTTP圧縮(GZIP)への対応-------------------------
            ' CType(wbreq, System.Net.HttpWebRequest).AutomaticDecompression = _
            '     System.Net.DecompressionMethods.GZip
            ' -----------------------------------------------
            CType(wbreq, HttpWebRequest).UserAgent = _
                "Mozilla/4.0 (compatible; MSIE 6.0; Windows XP)"
            CType(wbreq, HttpWebRequest).Headers.Add("Accept-Language", "ja")
            wbres = wbreq.GetResponse()

            ' Webレスポンス
            st = wbres.GetResponseStream()
            Dim bytes As Byte()
            Dim ttlSiz As Integer = 0
            Dim oneSiz As Integer
            Dim dat As Byte() = New Byte(-1) {}
            Do
                ' WebページのByte配列データ取得
                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 url As String = "http://nonsoft.la.coocan.jp/"
        Dim urls As String() = GetUrlList(url)
        If UBound(urls) >= 0 Then
            Process.Start(url)
            Application.DoEvents()

            ' Sitemap.xmlファイルオープン
            Dim dblPri As Double = 1.0
            Dim sw As IO.StreamWriter = New IO.StreamWriter("sitemap.xml", False)

            ' Sitemap.xmlヘッダー部分出力
            sw.WriteLine("<?xml version=""1.0"" encoding=""UTF-8""?>")
            sw.WriteLine("<urlset")
            sw.WriteLine("  xmlns=""http://www.sitemaps.org/schemas/sitemap/0.9""")
            sw.WriteLine("  xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance""")
            sw.WriteLine("  xsi:schemaLocation=""http://www.sitemaps.org/schemas/sitemap/0.9")
            sw.WriteLine("    http://www.sitemaps.org/schemas/sitemap/0.9/sitemap.xsd"">")
            sw.WriteLine("")

            ' トップURL分出力
            sw.WriteLine("<url>")
            sw.WriteLine("  <loc>" & url & "</loc>")
            sw.WriteLine("  <priority>" & dblPri.ToString("0.00") & "</priority>")
            sw.WriteLine("  <lastmod>" & Now.ToString("yyyy-MM-dd") & _
                "T" & Now.ToString("HH:mm:ss") & "+00:00" & "</lastmod>")
            sw.WriteLine("  <changefreq>daily</changefreq>")
            sw.WriteLine("</url>")

            For i As Integer = 0 To UBound(urls)
                ' URL分出力
                If urls(i).IndexOf(url) <> 0 Then Continue For
                dblPri = 0.9 - (CDbl(i) * 0.9 / CDbl(UBound(urls)))
                sw.WriteLine("<url>")
                sw.WriteLine("  <loc>" & urls(i) & "</loc>")
                sw.WriteLine("  <priority>" & dblPri.ToString("0.00") & "</priority>")
                sw.WriteLine("  <lastmod>" & Now.ToString("yyyy-MM-dd") & _
                    "T" & Now.ToString("HH:mm:ss") & "+00:00" & "</lastmod>")
                sw.WriteLine("  <changefreq>daily</changefreq>")
                sw.WriteLine("</url>")
            Next

            ' Sitemap.xmlフッター部分出力
            sw.WriteLine("</urlset>")

            ' Sitemap.xmlファイルクローズ
            sw.Close()
            sw = Nothing
        End If
    End Sub

End Class