ASIN/ISBNから商品ページ名を取得する

前に軽く触れた、ちょっとしたアマゾン用ツールというやつ。Amazon.co.jp用。
Kindle for PC でローカルに落としたKindle本でコレなんだったっけ?
と軽く調べるのに作成。

もっとちゃんとした類似ツールはどこかで見かけた気がする(失念)。


●概要

ASIN/ISBN(13桁または10桁)を引数で渡すか、
直接手入力することで、Webから商品ページ名を取ってくる。
CScriptで実行した場合の入出力にも対応しているので
バッチ処理に組み込むことも可能。
なお、ASIN/ISBNの指定は全半角問わず動作する。


●操作手順

GUIの場合(引数有り)

ASIN/ISBNを名前に含むファイルをVBSにドラッグドロップ。
ファイルは複数指定することが可能。
しばらくすると取得結果がダイアログに表示される。
(複数指定した場合、結果出力が以降も繰り返し表示される。)


CUIの場合(引数有り)

第1引数以降にASINまたはISBNを名前に含むファイル(フルパス)、
またはASIN(10桁)かISBN(10、13桁)の商品コードを指定して実行。
引数は複数指定することが可能。

CScript AmazonGetItemPageName.vbs [ファイル(フルパス)OR商品コード [ファイル(フルパス)OR商品コード] [...]]

しばらくすると取得結果が標準出力に表示される。
(複数指定した場合、結果出力が以降も繰り返し表示される。)


・引数無しの場合(GUICUI)

引数無しで実行した場合、
「ASIN/ISBN10桁またはISBN13桁を入力してください」という
プロンプトが表示されるので、ASIN/ISBNを入力して実行する。
しばらくすると取得結果がダイアログまたは標準出力に表示される。


●オプション設定

ソースの以下変数に対する値を変更することで
一部動作の変更が可能。

'IE表示設定(デフォルトは非表示)
'True=表示, False=非表示
Dim isIeVisible
isIeVisible = False

'結果出力設定(デフォルトは表示)
'True=表示, False=非表示
Dim isPutResult
isPutResult = True


●既知の問題

Q1.1件取得までの時間が長い
A1.Amazon商品ページが重く、取得完了までしばらく掛かる為

Q2.JANコードでの取得結果が正しくない
A2.ASIN、ISBN-10、ISBN-13何れかのコードのみ対応

Q3.購入履歴や、コンテンツと端末の管理から再ダウンロード出来る商品が
   正しく取得されない
A3.Amazonで販売終了している商品は404 Not Foundページ情報が帰る
   例):出版社が販売を終了したKindle本、期間限定無料のKindle本など


●実装について

要件が大したことなかったので、
ieオブジェクトからのスクレイピングでちゃちゃっと取得。
Amazon検索フォームを使わず存在し得るURLを生成、リクエストしている。
JANコードでの指定が不可なのはその為。

詳細な情報取るならAmazonAPIで取って来たXMLパースするのが最善だけど
さっさと作って使いたい場合には向いてないかなと。
(.net以前のVBだとリクエスト作るのに結構追加実装が必要だったり、
動かすのにもアソシエイトキー他諸々が必要だったりするし。)


AmazonGetItemTitle.vbs

Option Explicit

'ASCII <-> Shift_JIS 文字コード変換補数
Const SHIFT_CODE = &H7DE1

'バーション情報定数
Const APP_NAME = "AmazonGetItemTitle"
Const APP_VERSION = "Ver1.10"
Const APP_RELEASE = #2017/04/26#
Const APP_AUTHOR = "REGEKATSU"

'Amazon情報定数
Const PROTOCOL = "https"
Const DOMAIN = "www.amazon.co.jp"
Const TITLE_AGE_AUTH = "アダルトコンテンツ"
Const VERIFY_TOKEN = "はい"

'Amazon商品コード形式定数
Const CODE_UNKNOWN = -1
Const CODE_ASIN = 0
Const CODE_ISBN10 = 1
Const CODE_ISBN13 = 2

'実行中インタプリタ定数
Const RUNNING_UNKNOWN = -1
Const RUNNING_CSCRIPT = 0
Const RUNNING_WSCRIPT = 1

'IE表示設定(デフォルトは非表示)
'True=表示, False=非表示
Dim isIeVisible
isIeVisible = False

'結果出力設定(デフォルトは表示)
'True=表示, False=非表示
Dim isPutResult
isPutResult = True

Dim temp
Dim code

Dim index
Dim param
Set param = WScript.Arguments

'引数指定があった場合
For index = 0 To param.Count - 1
    temp = param(index)
    code = ""
    temp = StrConvNarrow(temp)
    
    'ファイル/フォルダ渡し(ASIN/ISBNを名前に含むファイル/フォルダ)
    If InStr(temp, "\") > 0 Then
        temp = Mid(temp, InStrRev(temp, "\") + 1)
        code = GetAsinOrIsbn(temp)
        
        '文字列渡し(ASIN/ISBN-10またはISBN-13を含む文字列)
    ElseIf Len(temp) >= 10 Then
        code = GetAsinOrIsbn(temp)
        
    End If
    
    If code <> "" Then
        'ISBN-10/ISBN-13だった場合、ISBN-10に変換または再計算する
        code = CalcIsbn10(code)
        'Amazon.co.jp商品ページから商品名を取得する
        GetItemTitle code, isIeVisible, isPutResult
    End If
Next

'引数指定がなかった場合
If param.Count <= 0 Then
    'ASIN/ISBNの入力を求める
    Dim prompt
    prompt = "ASIN/ISBN10桁またはISBN13桁を入力してください"
    If CheckRunningScript = RUNNING_CSCRIPT Then
        WScript.Echo APP_NAME & " " & APP_VERSION & vbCrLf & prompt
        temp = WScript.StdIn.ReadLine
    Else
        temp = InputBox(prompt, APP_NAME & " " & APP_VERSION)
    End If
    temp = StrConvNarrow(temp)
    
    '文字列渡し(ASIN/ISBN-10またはISBN-13)
    If Len(temp) = 10 Or Len(temp) = 13 Then
        code = GetAsinOrIsbn(temp)
    End If
    
    If code <> "" Then
        'ISBN-10/ISBN-13だった場合、ISBN-10に変換または再計算する
        code = CalcIsbn10(code)
        'Amazon.co.jp商品ページから商品名を取得する
        GetItemTitle code, isIeVisible, isPutResult
    Else
        '入力キャンセルした場合、処理を中断する
        WScript.Echo "処理を中断します。"
    End If
End If

Set param = Nothing

WScript.Quit


'サブルーチン

'指定したISBN-10/ISBN-13を元に計算後ISBN-10を返す
'指定した文字列がISBN-10/ISBN-13でなければ、そのままの文字列を返す
Function CalcIsbn10(isbn10_13)
    Dim code
    code = isbn10_13
    If CheckAsinOrIsbn(code) = CODE_ISBN13 Then
        'ISBN-13だった場合、ISBN-10に変換
        code = Isbn13ToIsbn10(code)
    ElseIf CheckAsinOrIsbn(code) = CODE_ISBN10 Then
        'ISBN-10だった場合、ISBN-10を再計算
        code = Isbn13ToIsbn10("978" & code)
    End If
    CalcIsbn10 = code
End Function

'指定した文字列にASIN/ISBNが含まれていれば該当文字列を返し、そうでなければ空文字を返す。
Function GetAsinOrIsbn(str)
    Dim code
    code = ""
    Dim RE, reMatch
    Set RE = CreateObject("VBScript.RegExp")
    With RE
        '文字列にISBN-13が含まれているか確認
        .Pattern = "[0-9]{13}"
        Set reMatch = .Execute(str)
        If reMatch.Count > 0 Then
            code = reMatch(0).Value
        Else
            Set reMatch = Nothing
            '文字列にASINまたはISBN-10が含まれているか確認
            .Pattern = "[0-9a-zA-Z]{10}"
            Set reMatch = .Execute(str)
            If reMatch.Count > 0 Then
                code = reMatch(0).Value
            End If
        End If
        Set reMatch = Nothing
    End With
    GetAsinOrIsbn = UCase(code)
    Set RE = Nothing
End Function

'指定した文字列にあるASIN/ISBNより商品コード形式を返す
'商品コード形式: CODE_UNKNOWN=-1, CODE_ASIN=0, CODE_ISBN10=1, CODE_ISBN13=2
Function CheckAsinOrIsbn(str)
    Dim RE
    Set RE = CreateObject("VBScript.RegExp")
    
    '文字列にISBN-13が含まれているか確認
    RE.Pattern = "[0-9]{13}"
    If RE.Test(str) Then
        CheckAsinOrIsbn = CODE_ISBN13
        Set RE = Nothing
        Exit Function
    End If
    
    '文字列にISBN-10が含まれているか確認
    RE.Pattern = "[0-9]{9}[0-9xX]{1}"
    If RE.Test(str) Then
        CheckAsinOrIsbn = CODE_ISBN10
        Set RE = Nothing
        Exit Function
    End If
    
    '文字列にASINが含まれているか確認
    RE.Pattern = "[0-9a-zA-Z]{10}"
    If RE.Test(str) Then
        CheckAsinOrIsbn = CODE_ASIN
        Set RE = Nothing
        Exit Function
    End If
    
    '文字列にASINまたはISBNが含まれていなかった場合
    CheckAsinOrIsbn = CODE_UNKNOWN
    Set RE = Nothing
End Function

'指定したISBN13桁またはチェックディジットを含まない12桁からISBN-10を返す
'指定した文字列に誤りがあった場合は空文字を返す
Function Isbn13ToIsbn10(isbn12_13)
    '指定した文字列が数字12桁または13桁の文字列であるか確認
    Dim RE
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "^[0-9]{12,13}$"
    RE.Global = True
    
    '指定した文字列に誤りがあった場合は空文字を返す
    If Not RE.Test(isbn12_13) Then
        Isbn13ToIsbn10 = ""
        Set RE = Nothing
        Exit Function
    End If
    Set RE = Nothing
    
    'ISBN13桁またはチェックディジットを含まない12桁からISBN-10を返す
    Dim isbn9
    Dim checkDigit
    isbn9 = Mid(isbn12_13, 4, 9)
    checkDigit = CalcCheckDigit11_10_2(isbn9)
    Isbn13ToIsbn10 = isbn9 & checkDigit
End Function

'指定した数字9桁か10桁、または10桁目が「X」の文字列に対するチェックディジットを返す
'(モジュラス11 ウェイト10-2)。
'指定した文字列に誤りがあった場合は空文字を返す
Function CalcCheckDigit11_10_2(isbn9_10)
    '指定した文字列が数字9桁か10桁、10桁目が「X」の文字列であるか確認
    Dim RE
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "^([0-9]{9}|[0-9]{9}[0-9xX]{1})$"
    RE.Global = True
    
    '指定した文字列に誤りがあった場合は空文字を返す
    If Not RE.Test(isbn9_10) Then
        CalcCheckDigit11_10_2 = ""
        Set RE = Nothing
        Exit Function
    End If
    Set RE = Nothing
    
    '旧規格のISBN(ISBN-10)のチェックディジット計算(Wikipedia参照)
    
    Const MODULUS = 11
    Const WAIT = 10
    
    Dim temp
    Dim sum
    Dim remainder
    Dim ret
    
    Dim index
    
    'チェックディジットを除いた左側の桁から10、9、8…2を掛けてそれらの和を取る。
    sum = 0
    For index = 0 To 8
         temp = (CInt(Mid(isbn9_10, index + 1, 1)) * (WAIT - index))
         sum = sum + temp
    Next
    
    '和を11で割って出た余りを11から引く
    remainder = sum Mod MODULUS
    ret = MODULUS - remainder
    
    'なお、計算結果が10になった場合、10の代わりにX(アルファベットの大文字)を用いる。
    If ret = WAIT Then
        CalcCheckDigit11_10_2 = "X"
        
        'また、11になった場合は、0となる。
    ElseIf ret = MODULUS Then
        CalcCheckDigit11_10_2 = "0"
        
        'それ以外になった場合は、チェックディジットは計算結果の値となる
    Else
        CalcCheckDigit11_10_2 = CStr(ret)
        
    End If
End Function

'ieでAmazonサイトの指定したASIN/ISBN-10商品ページを開き、商品名を取得する
Sub GetItemTitle(code, isIeVisible, isPutResult)
    Dim title
    Dim url
    Dim ie
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = isIeVisible
    
    url = PROTOCOL & "://" & DOMAIN & "/dp/" & code
    ie.Navigate url
    
    On Error Resume Next
    
    WaitIE(ie)
    
    '年齢認証ページかどうか確認。認証ページであれば認証を進める
    AdvancedAgeAuth(ie)
    WaitIE(ie)
    
    title = ie.document.title
    
    'IEを表示しない場合、バックグラウンドで開いているIEを閉じる
    If Not isIeVisible Then
        ie.Quit
    End If
    
    Set ie = Nothing
    
    On Error GoTo 0
    
    If isPutResult Then
        '取得した商品名を出力
        Dim prompt
        prompt = "CODE: " & code & vbCrLf & "URL: " & url & vbCrLf & "TITLE: " & title
        If CheckRunningScript = RUNNING_CSCRIPT Then
            WScript.Echo prompt
        Else
            InputBox prompt, APP_NAME & " " & APP_VERSION, title
        End If
    End If
End Sub

'指定されたIEがECサイトの年齢認証ページであれば認証を進める。
Sub AdvancedAgeAuth(ie)
    Dim domain
    Dim title
    domain = ie.document.domain
    title = ie.document.title
    
    If domain = DOMAIN And _
        InStr(title, TITLE_AGE_AUTH) > 0 Then
        Dim objAnchor
        For Each objAnchor In ie.document.getElementsByTagName("A")
            If InStr(objAnchor.innerText, VERIFY_TOKEN) > 0 Then
                objAnchor.Focus
                objAnchor.click
                Exit For
            End If
        Next
    End If
End Sub

'IEページが表示されるまで待つ
Sub WaitIE(ie)
    Do While ie.Busy = True Or ie.readyState <> 4
    Loop
End Sub

'実行中インタプリタの情報を取得する
'実行中インタプリタ: RUNNING_UNKNOWN=-1, RUNNING_CSCRIPT=0, RUNNING_WSCRIPT=1
Function CheckRunningScript()
    Const WSCRIPT_EXE = "wscript.exe"
    Const CSCRIPT_EXE = "cscript.exe"
    
    If LCase(Right(WScript.FullName, Len(WSCRIPT_EXE))) = WSCRIPT_EXE Then
        CheckRunningScript = RUNNING_WSCRIPT
    ElseIf LCase(Right(WScript.FullName, Len(CSCRIPT_EXE))) = CSCRIPT_EXE Then
        CheckRunningScript = RUNNING_CSCRIPT
    Else
        CheckRunningScript = RUNNING_UNKNOWN
    End If
End Function

'指定した文字列の全角英数を半角に変換して返す
Function StrConvNarrow(strWide)
    Dim length, index, retStr, retChar, tempChar, tempCode
    retStr = ""
    StrConvNarrow = retStr
    
    length = Len(strWide)
    For index = 1 To length
        tempChar = Mid(strWide, index, 1)
        tempCode = Asc(tempChar)
        If (tempCode >= &H824F And tempCode <= &H8258) Or _
            (tempCode >= &H8260 And tempCode <= &H8279) Then
            '文字コードが Shift_JIS 0~9: &H824F~&H8258 
            'または A~Z: &H8260~&H8279 だった場合
            retChar = Chr(tempCode + SHIFT_CODE)
            
        ElseIf tempCode >= &H8281 And tempCode <= &H829A Then
            '文字コードが Shift_JIS a~z: &H8281~&H829A だった場合
            retChar = Chr(tempCode + SHIFT_CODE - 1)
        Else
            '文字コードが変換対象外だった場合
            retChar = tempChar
            
        End If
        retStr = retStr & retChar
    Next
    
    StrConvNarrow = retStr
End Function