ココログ：古い「カテゴリ別書評一覧」から各記事の旧URL 一覧を作るVBScript

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

【はじめに】

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

　今までの作業で「どの記事の、どのリンクが外れているか」の一覧ができた。ただ、外れたリンクは URL しか分からない。一応はアンカーテキストも取り出しているのだが、実はこれ、ほとんど信用できないし。

　なんにせよ。

　今のところ、「この URL が間違っている」のは、分かる。でも、それを「どう直せばいいか」が、分からない。

　そこで、間違ったURL：正しいURL の一覧 が欲しい。

　幸いにして、このブログの記事の大半は書評だ。そして、これもラッキーな事に、「カテゴリ別書評一覧」なんて頁も作ってあった。これを使えば、間違ったURL：記事名 の一覧が作れる。

　既に 正しいURL：記事名 の一覧がある。(ココログ：全公開記事のHTMLから記事一覧を作るVBScript)。今までは URL => 記事名 の形で使っていたが、逆に 記事名 => URL としても使える。

　この二つを使えば、間違ったURL => 記事名 => 正しいURL と手繰れる、つまり 間違ったURL：正しいURL の一覧が作れるだろう。

　という事で、ここでは、古い「カテゴリ別書評一覧」から、間違ったURL：記事名 の一覧を作る。

【古い「カテゴリ別書評一覧」】

　中身はこんな感じ。

　￤
<li><a href="古いURL">
記事名</a></li>
<li><a href="古いURL">
記事名</a></li>
　￤

　中身はこんな感じ。

【間違ったURL：記事名 の一覧】

　それを、こんな形に変換する。

古いURL 記事名
古いURL 記事名
　￤

　区切りはタブ文字とした。

【ソース】

　名前は makeOldList.vbs とした。古い「カテゴリ別書評一覧」をドラッグ＆ドロップすると、間違ったURL：記事名 の一覧ができる。

' 2018.11.07 旧ctindexからURL=>記事名一覧作る 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 <> 1 then
    Call MsgBox( "ctindex.htmlをD&Dしる" )
    WScript.Quit
end if

' D&Dしたファイル名からフルパスと親フォルダを得る
Dim cName   : cName     = WScript.Arguments.Item(0) ' D&Dしたファイルのフルパス
Dim cFolder : cFolder   = FSYS.getParentFolderName( cName ) & "\" '親フォルダ名

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

' 記事へのリンクの正規表現
Dim rURL, rTTL, oBuf, hURL, hTTL
Set rURL = new RegExp : rURL.IgnoreCase = True    '<li><a href=URL>
Set rTTL = new RegExp : rTTL.IgnoreCase = True    '記事名</a></li>
rURL.pattern = "^<li><a href=.(" & blogURL & "[^>]+).>"
rTTL.pattern = "^(.+)</a></li>"

' 全記事の全文のスキャン
oBuf = "" : hURL = ""
Do While iHandle.EOS = False
    Dim line : line = iHandle.ReadText( -2 )
'                                           <li><a href=URL>
    If rURL.Test( line ) then
        hURL   = rURL.Replace( line, "$1" )
'                                           記事名</a></li>
    ElseIf rTTL.Test( line ) and hURL <> "" then
        hTTL   = rTTL.Replace( line, "$1" )
        oBuf = oBuf & hURL & vbtab & hTTL & vblf
    end if
Loop
iHandle.Close
                    ' 結果の書き出し
Dim oHandle
Set oHandle = CreateObject("ADODB.Stream")
oHandle.Charset = "UTF-8"
oHandle.Open
oHandle.WriteText oBuf, 0
oHandle.SaveToFile cFolder & "oldCtindex.txt", 2        '上書き

oHandle.Close
Call MsgBox( "Finish" )

【関連記事】

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

【つぶやき】

　この手の作業は awk か perl ならもっと楽なのにブツブツ…と思ったら、ActivePerl や Strawberry Perl とか、いろいろあるじゃないか。ちったあ調べろよ俺。でも文字コード関係はやっぱり面倒くさそう。