itestURL2jane.vbs

' itestURL2jane.vbs
' ■itestURL2jane.vbsについて
' itest.5ch.net のURL を実際の5cn URL に変えてJaneで開く
' command.dat を使用できる jane で共通して利用可能
' 次のような２つの形式に対応しています
' http://itest.5ch.net/corn/test/read.cgi/entrance/990712570/
' http://itest.5ch.net/test/read.cgi/entrance/1592129652
' httpsにも対応、itest.2ch.netにも対応しています
' 変換後のURLはhttpとしています
' 20200630

' ■使用方法
' このスクリプトを itestURL2jane.vbs として保存し
' command.datに
' itestURL2jane=wscript "itestURL2jane.vbs" {jane_exe} {curl_exe} {itest_url} [2ch.net|5ch.net]
' のように記述する
' itestURL2jane.vbs : このスクリプト
' 　　Jane2ch.exe と同じディレクトリにおいた場合以外はフルパス名で指定
' jane_exe ： janeのexeファイル名
' curl_exe ： curlのexeファイル名
' 　　curlがない場合は https://curl.haxx.se/ からダウンロードしてください
' 　　jane_exe curl_exeは原則フルパス名だが、
' 　　パスが通っているかカレントディレクトリならフルパス不用
' itest_url ： itestのURL
' 　　"http://itest.5ch.net/test/read.cgi/entrance/1592129652" などだが
' 　　command.dat では $LINK
' 2ch.net|5ch.net ： 2ch.netまたは5ch.netの指定はどちらのドメインで開くかの指定
' 　　省略すればもとのiltestでの指定に従うが
' 　　Janeが2ch.netまたは5ch.netを扱えるように設定されていない場合、対象外のURLとして無視される
'
' jane での操作は
' 表示しているスレのitestリンク上で右クリックしメニューからitestURL2janeを選択する

' ■具体的なcommand.dat設定例
' itestURL2jane=wscript "itestURL2jane.vbs" "Jane2ch.exe" "curl.exe" "$LINK" 5ch.net

'■テストに使用したitestリンクのあるスレ
'http://rosie.5ch.net/test/read.cgi/famicom/1593440400/
'https://rio2016.5ch.net/test/read.cgi/twwatch/1545191721/
'https://rio2016.5ch.net/test/read.cgi/twwatch/1589292051/
'https://rio2016.5ch.net/test/read.cgi/twwatch/1589360808/
'http://egg.5ch.net/test/read.cgi/smartphone/1507034881/

Option Explicit

Dim exit_code
exit_code = 0
if 3>WScript.Arguments.Count then
    WScript.echo("パラメータが不足しています")
    WScript.echo("itestURL2jane.vbs {jane_exe} {curl_exe} {itest_url} [2ch.net|5ch.net]")
    WScript.Quit(exit_code)
end if

Dim src_url, new_url, domain
Dim curl_exe, jane_exe


jane_exe = WScript.Arguments(0) 'jane_exe = "C:\jane\JaneXeno2ch.exe" など
curl_exe = WScript.Arguments(1) 'curl_exe = "C:\test\curl.exe" など
src_url = WScript.Arguments(2)  ' "http://itest.5ch.net/test/read.cgi/entrance/1592129652" など
domain = ""
if 3<WScript.Arguments.Count then
    domain = WScript.Arguments(3)
end if


Dim Matches
Set Matches = RexExecute(src_url, "https?://itest\.([25]ch\.net)/([a-z0-9]+)(/test/read.cgi/[^/]+/[0-9]+/?)", True, True)
'Set Matches = RexExecute(src_url, "https?://itest\.([25]ch\.net)(/test/read.cgi/[^/]+/[0-9]+/?)", True, True)
If ( 1 = Matches.Count ) Then
    ' サイトに問い合わせなくても変換できるタイプ
    ' https://itest.5ch.net/corn/test/read.cgi/entrance/990712570/
    exit_code = 10
'   MsgBox Matches(0).Value
'   MsgBox Matches(0).SubMatches.Count
'   MsgBox Matches(0).SubMatches(0)
'   MsgBox Matches(0).SubMatches(1)
'   MsgBox Matches(0).SubMatches(2)
    If ( "" = domain ) Then
        new_url = "http://" & Matches(0).SubMatches(1) & "." & Matches(0).SubMatches(0) & Matches(0).SubMatches(2)
    Else
        new_url = "http://" & Matches(0).SubMatches(1) & "." & domain & Matches(0).SubMatches(2)
    End If
Else
    ' サイトに問い合わせないと変換できないタイプ
    'http://itest.5ch.net/test/read.cgi/entrance/1592129652
    exit_code = 20
    new_url = itest_url_by_site(src_url, domain)
End If
'MsgBox "new_url=" & new_url

If ( "" = new_url ) Then
    WScript.echo( "URLを変換できません。" )
Else
    exit_code = exit_code + 1
End If

RunExe jane_exe & " " & new_url, 1, False

'Quitメソッドの引数値は、バッチファイルでerrorlevelになる。
Wscript.Quit(exit_code)

Function itest_url_by_site(src_url, domain)
    itest_url_by_site = ""
    Dim Matches
    Set Matches = RexExecute(src_url, "https?://itest\.([25]ch\.net)(/test/read.cgi/[^/]+/[0-9]+/?)", True, True)
    If (0 = Matches.Count) Then
        Exit Function
    End If

    Dim access_url,temp_file
    If ("2ch.net" = Matches(0).SubMatches(0)) Then
        ' もとのurlがitest.2ch.netの場合アクセスできないので5ch.netに
        access_url = "https://itest.5ch.net" & Matches(0).SubMatches(1)
    Else
        access_url = src_url
    End If
    temp_file = GetEnvironmentString("TEMP") & "\itest2jane_temp.txt"

    ' curl を使い itest のURLにアクセスし戻ってきたページソースをtemp_fileとする
    RunExe curl_exe & " -s " & access_url & " -o " & temp_file, 0, True

    ' 以下itestのページソースからホスト名を取り出す
    Dim objStreamIn
    Set objStreamIn = CreateObject("ADODB.Stream")

    ' 文字コードを設定
    objStreamIn.Charset = "UTF-8"

    ' ファイルオープン
    objStreamIn.Open

    ' 入力ファイルを読み込む'
    'objStreamIn.LoadFromFile "F:\temp\work\PathScan\ii.txt"
    objStreamIn.LoadFromFile temp_file
    ' データを変数に格納する

    'ReadText(-1)でテキスト全文を、ReadText(-2)でテキスト1行を読み込むことができます。
    ' CR+LFしか改行として認識されない
    ' ここで扱うitestのページソースはLFのみなので-2でも実質-1と変わらない
    Dim strData
    Dim webMatches
    Do while (1)
        strData = objStreamIn.ReadText(-2)
        if ("" = strData) Then
            exit Do
        End If

        Set webMatches = RexExecute(strData, "pchost = '([a-z0-9]+)\.([25]ch\.net)';", True, True)
        'MsgBox webMatches.Count
        if (1 = webMatches.Count) Then
            exit Do
        End If
    Loop

    if (1 = webMatches.Count) Then
        'MsgBox webMatches(0).Value
        'MsgBox webMatches(0).SubMatches.Count
        'MsgBox webMatches(0).SubMatches(0)
        If ( "" = domain ) Then
            itest_url_by_site = "http://" & webMatches(0).SubMatches(0) & "." & Matches(0).SubMatches(0) & Matches(0).SubMatches(1)
        Else
            itest_url_by_site = "http://" & webMatches(0).SubMatches(0) & "." & domain & Matches(0).SubMatches(1)
        End if
    End if
'   MsgBox itest_url_by_site

    ' ファイルクローズ
    objStreamIn.Close

    Set objStreamIn = Nothing

    ' temp_file を削除
    FileDelete temp_file, False

End Function

Function RexExecute(str, pattern, IgnoreCase, Global)
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = pattern            ' パターンを設定します。
    regEx.IgnoreCase = IgnoreCase           ' 大文字と小文字を区別する
    regEx.Global = Global
    regEx.MultiLine = True

    Set RexExecute = regEx.Execute(str)
End Function

Function FileDelete(file, bDeleteReadOnly)
    Dim objFso
    Set objFso = CreateObject("Scripting.FileSystemObject")
    objFso.DeleteFile file, bDeleteReadOnly
    Set objFso = Nothing
End Function

Function GetEnvironmentString(variable_name)
    Dim objWShell
    Set objWShell = CreateObject("WScript.Shell")
    GetEnvironmentString = objWShell.ExpandEnvironmentStrings("%"&variable_name&"%")
    Set objWShell = Nothing
End Function

Function RunExe(exe_and_param, ShowStyle, bWaitTerminate)
'exe_and_param
' 実行するexeファイルと' 'で区切られたパラメータ
'ShowStyle
'0 ウィンドウを非表示
'1 通常のウィンドウで、最前面のウィンドウ
'2 最小化で、最前面のウィンドウ
'3 最大化で、最前面のウィンドウ
'4 通常のウィンドウで、最前面ではない
'6 最小化で、最前面にはならない
'bWaitTerminate
'True - コマンドの終了を待つ。
'False - コマンドの終了を待たずスクリプトを実行する。
    Dim objWShell
    Set objWShell = CreateObject("WScript.Shell")
    objWShell.Run exe_and_param, ShowStyle, bWaitTerminate
    Set objWShell = Nothing
    RunExe = 0
End Function