前に軽く触れた、ちょっとしたアマゾン用ツールというやつ。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商品コード] [...]]
しばらくすると取得結果が標準出力に表示される。
(複数指定した場合、結果出力が以降も繰り返し表示される。)
引数無しで実行した場合、
「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コードでの指定が不可なのはその為。
詳細な情報取るならAmazonのAPIで取って来た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