ココログ：全公開記事のHTMLから記事一覧を作るVBScript

ココログ：外れている内部リンクを探す のお仕事。ココログ：各月のURL一覧から全公開記事をダウンロードするVBScript から続く。

【はじめに】

　最終目的は、ココログの私の全記事から、外れている内部リンクを探すこと(→ココログ：外れている内部リンクを探す)。その第一段階として、公開中の全記事をダウンロードした(→ココログ：各月のURL一覧から全公開記事をダウンロードするVBScript)。

　この記事では、全記事のファイルから URL：記事名 の一覧を作る。

【全記事のファイル】

　中には全記事のHTMLが入っている。大事なのは記事の見出しの部分で、こんな風になっている。

　￤
<h3><a href="http://chikuwablog.cocolog-nifty.com/blog/2018/11/post.html">「KGBの世界都市ガイド」晶文社 小川政邦訳</a></h3>
　￤
<h3><a href="http://chikuwablog.cocolog-nifty.com/blog/2018/11/sf-f09f.html">アン・レッキー「動乱星系」創元SF文庫 赤尾秀子訳</a></h3>
　￤

　要は<h3><a href="記事のURL">記事名</a></h3> って形で、記事のURLと記事名がわかるのだ。これを取り出せばいい。

【URL：記事名】

　取り出したら、次の形のテキスト・ファイルにする。URLと記事名の区切りはタブ文字。

http://chikuwablog.cocolog-nifty.com/blog/2018/11/post.html	「KGBの世界都市ガイド」晶文社 小川政邦訳
http://chikuwablog.cocolog-nifty.com/blog/2018/11/sf-f09f.html	アン・レッキー「動乱星系」創元SF文庫 赤尾秀子訳
　￤

【ソース】

　名前は makeURLList.vbs とした。これに全記事のファイルをドラッグ＆ドロップすると、URL：記事名 のファイル URLlist.txt ができる。

' 2018.11.05 記事全文から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( "記事全文を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, oBuf
Set rURL = new RegExp : rURL.IgnoreCase = True    '<h3><a href=URL>記事名</a></h3>
rURL.pattern = "^.*<h3><a href=.(" & blogURL & "[^>]+).>([^<]+)</a></h3>.*$"

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

iHandle.Close
oHandle.Close
Call MsgBox( "Finish" )

【関連記事】

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