ココログ：切れている内部リンクの一覧を作るVBScript

ココログ：外れている内部リンクを探す のお仕事。ココログ：全公開記事のHTMLから記事一覧を作るVBScript から続く。

【はじめに】

　　最終目的は、ココログの私の全記事から、外れている内部リンクを探し、リンク外れの一覧を作る(→ココログ：外れている内部リンクを探す)。

　そのため、まず公開している全記事をダウンロードし、次に 記事のURL：記事名 の一覧を作った。

　ここでは、全記事のHTML と記事一覧を突き合わせ、外れている内部リンクの一覧を作る。

【だいたいの手順】

　手順はこんな感じ。

1. 記事一覧を全部読み、記事URL => 記事名 の辞書を作る。
2. 公開している全記事を１行ごとに読んで、内部リンクがあったら １．で作った辞書を調べる。
   辞書になければ、そのリンクは切れているので、リンク外れの一覧に書き出す。

【入力と出力】

　入力は２つ。記事のURL：記事名一覧 と、全記事のHTML。

　出力はリンク外れの一覧。以下の形のテキストファイル。

記事URL 記事名 リンク外れのURL リンク外れのアンカー・テキスト
記事URL 記事名 リンク外れのURL リンク外れのアンカー・テキスト
　￤

【欠点】

　分かっている限り、少なくとも２個の欠点がある。

　まず、記事のHTMLは記事一覧より長くなきゃいけない。全記事に対しこのスクリプトを使うなら問題ない。だが一部の記事だけリンク外れを調べたい、なんて時には使えない。

　このスクリプトは２つのファイル、記事HTMLと記事一覧をドラッグド＆ロップして起動する。スクリプトは、受け取った２つのファイルを見て、どっちが記事HTMLでどっちが記事一覧かを判断しなきゃいけない。そこで単純に、よりファイルサイズが大きい方を記事HTML、と判断することにした。

　もう一つは、書き出す「リンク外れの一覧」のうち、「リンク外れのアンカー・テキスト」が信用できないこと。往々にして間違っている。とりあえず私は困らないんで、放置した。

【ソース】

　　名前は Merge.vbs とした。これに記事のURL：記事名一覧 と全記事のHTMLをドラッグ＆ドロップすると、リンク外れの一覧ができる。

' 2018.11.05 記事中の内部リンクを調べる vb5.8
Option Explicit

Const blogURL = "http://chikuwablog.cocolog-nifty.com/blog/"
Dim WSH : Set WSH  = WScript.CreateObject( "Wscript.shell" )
Dim FSYS: Set FSYS = WScript.CreateObject( "Scripting.FileSystemObject" )

' ダブルクリックで起動したら使い方を示して終わる
if WScript.Arguments.length <> 2 then
    Call MsgBox( "記事全文とURL一覧をD&Dしる " & WScript.Arguments.length )
    WScript.Quit
end if

' D&Dしたファイル名からフルパスと親フォルダを得る
Dim cName   : cName     = WScript.Arguments.Item(0) ' D&Dしたファイルのフルパス
Dim lName   : lName     = WScript.Arguments.Item(1) ' D&Dしたファイルのフルパス
Dim cFolder : cFolder   = FSYS.getParentFolderName( cName ) & "\" '親フォルダ名
' 大きいファイルは記事、小さいファイルは一覧
if fileSize( cName ) > fileSize( lName ) then
    Dim w
    w = cName
    cName = lName
    lName = w
end if

' 一覧ファイルを読み、辞書lURLに登録
Dim lURL
Set lURL = makeLinkDic( lName )

' 記事へのリンクの正規表現
Dim rURL, oBuf, hURL, hTitle, rRef, tURL, tTitle
Set rURL = new RegExp : rURL.IgnoreCase = True   '<h3><a href=URL>記事名</a></h3>
Set rRef = new RegExp : rRef.IgnoreCase = True   '<a href=URL>記事名
rURL.pattern = "^.*<h3><a href=.(" & blogURL & "[^>]+).>([^<]+)</a></h3>.*$"
rRef.pattern = "^.*<a href=.(" & blogURL & "\d\d\d\d/\d\d/[^>]+html).>([^<]*)$"

' 全記事の全文のスキャン
oBuf = ""
Dim cHandle : Set cHandle = openFile( cName )
Do While cHandle.EOS = False : do
    Dim l : l = cHandle.ReadText( -2 )
'                                        記事名行,<h3><a href=URL>記事名</a></h3>
    if rURL.Test( l ) then
        hURL   = rURL.Replace( l, "$1" )
        hTitle = rURL.Replace( l, "$2" )
        Exit Do
    End If
'                                       </a>で分割して
    Dim k
    For Each k in Split( l, "</a>", -1 ) : do
        if not rRef.Test( k ) then : Exit do : End If
        tURL   = rRef.Replace( k, "$1" )
        tTitle = rRef.Replace( k, "$2" )
        if InStr( tURL, "index.html" ) > 0 then : Exit do : End If
        if lURL.Exists( tURL ) Then : Exit do : End If
        oBuf = oBuf & hURL & vbtab & htitle & vbtab & tURL & vbtab & tTitle & vbcrlf
    Loop Until 1 : Next
Loop Until 1 : Loop
cHandle.Close
                    ' 結果の書き出し
Dim oHandle
Set oHandle = CreateObject("ADODB.Stream")
oHandle.Charset = "UTF-8"
oHandle.Open
oHandle.WriteText oBuf, 0
oHandle.SaveToFile cFolder & "lostLinkList.txt", 2        '上書き
oHandle.Close
Call MsgBox( "Finish" ) : WScript.Quit

' fileSize( fName ) : ファイル fName のサイズを返す
Function fileSize( fName )
    Dim fi
    Set fi = FSYS.GetFile( fName ) 
    fileSize = FormatNumber( fi.Size, 0 )
End Function

' openFile( fName ) : ファイル fName を開いて返す
Function openFile( fName )
    Dim fHandle

    Set fHandle = CreateObject("ADODB.Stream")
    fHandle.Type          = 2                ' text mode
    fHandle.charset       = "utf-8"
    fHandle.LineSeparator = 10    ' lf
    fHandle.open
    fHandle.LoadFromFile fName '入力ファイルを読み込む
    If Err.Number <> 0 Then
        Call MsgBox( "Code:" & Err.Number & " :Can not open " & fName )
        WScript.Quit
    end if
    Set openFile = fHandle
end Function

' makeLinkDic( lName ) : ファイルlNameから(URL:記事名)の辞書を作る
Function makeLinkDic( lName )
    Dim lHandle : Set lHandle = openFile( lName )
    Dim lURL    : Set lURL =WScript.CreateObject( "Scripting.Dictionary" )

    Do While lHandle.EOS = False
        Dim line, col
        
        line = lHandle.ReadText( -2 )
        col = Split( line, vbtab, -1 )  ' URL tab Title
        lURL.Add col(0), col(1)
    Loop
    lHandle.Close
    Set makeLinkDic = lURL
End Function

【おわりに】

　ココログ：外れている内部リンクを探す ために、これを含め３つのスクリプトを書いた。1)記事全文をダウンロード，2)記事一覧を作る，3)外れている内部リンクを探す だ。

　この３つのスクリプト、１つのスクリプトにまとめてもいい。というか、サービスとして一般に公開するなら、たぶん１つのスクリプトにしちゃう。１本にすると、途中のファイル、例えば記事名一覧とかが要らなくなる。

　そうしなかったのは、分けた方が楽に作れるからだ。

　私の場合、スクリプトを作る時間の８割以上をデバッグ、つまり間違い探しに費やす。1本作るのに、数十回も試行錯誤する。

　こういう時は、作業をなるたけ細かく複数の段階に分けて、各段階ごとに一歩一歩進めていく方がいい。記事名一覧も、いったんテキスト・ファイルに書き出せば、その中身をテキスト・エディタで確認できる。

　それはともかく。

　この作業を通じて、色々と VBScript について分かったのが嬉しい。関数かたオブジェクトを返す方法，連装配列の使い方，タブ区切りテキストをカラムに分ける方法，HTTPリクエストを送る方法，ループ内の If から continue する手口。

　JavaScript などと違い、Do などのブロックは変数のスコープを作らないのは新しい発見。また変数に型がないってのも知らなかった。道理で As がエラーになるわけだ。どころか、VBScript と VBA は違うって事に、やっと気がついた。間抜けな話だ。

　もっとも、全般的に VBA の方が VBScript よりパワフルだし、Microsoft は今後 PowerShell に力を入れていくだろうから、今さら VBScript を覚えても、あまし利益はないだろうなあ。

【関連記事】

• ココログ：外れている内部リンクを探す
• ココログ：各月のURL一覧から全公開記事をダウンロードするVBScript
• ココログ：全公開記事のHTMLから記事一覧を作るVBScript
• ココログ：切れている内部リンクの一覧を作るVBScript
• ココログ：古い「カテゴリ別書評一覧」から各記事の旧URL 一覧を作るVBScript
• ココログ：リンク切れ一覧と旧URL一覧と公開記事URL一覧を突き合わせるOpenOfficeCalc