kksn_ripper.py でキラキラスターナイト パーフェクトブック(同人誌版)と 8BIT MUSIC POWER サウンドブックのROMイメージ抽出

表題の通り、以下書籍の付録CD-ROMに収録されている
VirtuaNES組み込み実行ファイルからROMイメージ抽出するためのもの。
同様のROMイメージが既に同梱されているから、そもそも抜き出す必要は無いんだけどね。

尚、抽出ツールは別途 id:eagle0wl さんの所から入手しているものとする。

キラキラスターナイトDXパーフェクトブックを買った&ROMイメージ抽出した
http://eagle0wl.hatenadiary.jp/entry/2017/05/01/045856

この Python ソースによれば、どうやらバイナリを切り出し後、
LZSS アルゴリズムの展開を経て ROM イメージを吐き出していることが解る。
VirtuaNES組み込み作品では、ミスタースプラッシュ!だけが無圧縮だったようだ…。


・キラキラスターナイト パーフェクトブック (同人誌) 付録 CD-ROM に収録の、
StarNight.exe から StarNight.nes を抽出出来るようにする。

kksn_ripper.py

22行目に下記1行を追加

rip_status_table.append({'md5_hash': u'c2f4ea91d22996019741a553e350c791', 'offset': 0x0006A294, 'size': 0x00027B7E}) # StarNight.exe


・8BIT MUSIC POWER サウンドブック 付録ディスクに収録の、
8BIT MUSIC POWER.exe から 8BIT MUSIC POWER.nes を抽出出来るようにする。

kksn_ripper.py

22行目に下記1行を追加

rip_status_table.append({'md5_hash': u'3fdfb465b8de155208e4cf4c86001b6b', 'offset': 0x00069074, 'size': 0x000401E2}) # 8BIT MUSIC POWER.exe

23行目のNESヘッダ定義を下記の通り修正

commoniNESHeader = '4E45531A102042000000000000000000'.decode('hex')
↓
commoniNESHeader = '4E45531A202040000000000000000000'.decode('hex')

UNLHA32.DLLをVBSから利用してファイルをLZH圧縮する。

お仕事スクリプトで、VBScriptのみによるLZH圧縮という
要望が出てきたので調査、対応してみた。
PCにはMS OfficeとLHUT32というアーカイバが入っている前提。

VBVBAだと割かし実装例が出て来るのだけど、
やはりというか、Declareステートメントの無いVBS環境で
わざわざ動かそうってチャレンジャーは見当たらなかった。
解凍だけならVista以降OS標準で行けるんだが。

利用するDLLはUNLHA32.DLLで用いるのはUnlhaという関数。

UNLHA32.DLL

int WINAPI Unlha(const HWND _hwnd, LPCSTR _szCmdLine,
        LPSTR _szOutput, const DWORD _dwSize)

この関数を、他サイトで見たVBAの実装例を参考に、
作成したラッパー関数が以下。

'Unlha関数(UNLHA32.DLL)を実行する。
'操作に成功したらTrueを、そうでなければFalseを返す
Function ExecUnlha(szCmdLine)
    Const DW_SIZE = 256 '出力バッファサイズ
    Dim command
    
    'UNLHA32.DLL 呼び出しコマンドを生成する
    command = "CALL(""unlha32"", ""Unlha"", ""JJCFJ"", 0, " & """" & szCmdLine & """" & ", 0, " & DW_SIZE & ")"
    
    'unlha32 を呼び出す
    If CreateObject("Excel.Application").ExecuteExcel4Macro(command) = 0 Then
        ExecUnlha = True
    Else
        ExecUnlha = False
    End If
End Function

VBSからのDLL呼び出しにはExcel CALL関数を利用。
他にSFC miniやDynacallを使ったDLL利用例も見たが
追加インストール無しって条件だと、
これ以外で選択の余地は無かった。

Sub Test()
    If ExecUnlha("a c:\work\test.lzh c:\work\test.txt") = False Then
        MsgBox "ExecUnlha error!"
    End If
End Sub

ちょっと悩んだのは引数タイプのところ。
第3引数で使われるバッファ用バイト配列の指定方法だが、
結論としては"JJCFJ"とすることで、実行時エラー無くLZH圧縮を行うことが出来た。

どうやらCALL関数にて参照先の変更を伴う変数を指定する場合、
データ型をFまたはGと指定し、CALL文上では0とすることで、
予め用意されている256バイト領域が割り当てられるようだった。

解り辛い…!というのがこの引数タイプの感想。
そもそもVBS縛りってのが茨の道な気がしないでもないが。

敢てExecuteExcel4Macroで頑張ってみたいなら
下記リンク先を読めば理解が深まるかも知れない。


CALL 関数と REGISTER 関数の使い方 - Office サポート
https://support.office.com/ja-jp/article/CALL-%E9%96%A2%E6%95%B0%E3%81%A8-REGISTER-%E9%96%A2%E6%95%B0%E3%81%AE%E4%BD%BF%E3%81%84%E6%96%B9-06fa83c1-2869-4a89-b665-7e63d188307f

VBScriptAPI 呼び出し ( ソフトウェア ) - 特になし - Yahoo!ブログ
https://blogs.yahoo.co.jp/nobuyuki_tsukasa/5364628.html

VBScript内でdll(参照渡しの引数含む)を利用したいと考えています... - Yahoo!知恵袋
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1387232963

CUBIC STYLEさん新作GBAのお手伝いとか。

もう今週末からコミックマーケット92なんだけども。
CUBIC STYLEさんで頒布予定のGBA新作で少しだけお手伝いをした。

cubic-style.jp

コーディングじゃなくデバッグ要員として。
エミュや実機検証はタクトさん本人が
開発と並行で随時していたので、
自分は主にレトロフリークでの動作検証をば。

粗方のバグや不具合も取れたという事で、
既にプレス業者に入稿済みだそうな。

この「巫女ぱら」という作品自体は
初出2005年の結構前に出されたタイトルであり、
今回そのリファイン版と言うべきものではあるが。

フルボイス化が成されたり、画面効果が増強されたり、
細かい作り込みや、パッケージが一新された等、
かなり本気で取り組まれている様子。

もし気になるようであれば当日サークルスペースに足を運んで、
見て貰えると宜しいかも知れない。

コミックマーケット92
1日目(金曜日) 東地区 す-42b
CUBIC STYLE

また、別枠ではあるが巫女ぱらのボイス集が
音声を担当された夢前黎様より DLSite.com にて
同日販売開始される模様。
こちらも併せてチェックするとより良いかと。

『巫女ぱら』ボイス集(CV:夢前黎) - Re:I

それと手前味噌で申し訳ないが。
巫女ぱら繋がりということで。。

先日 Pebble 用ウォッチフェイスをジェネレータで作ってみたので、
持ってる人は気が向いたときにでも使ってくれると嬉しいかも。

※ダウンロードはこちらから

Googleドライブにある画像の直リンクをクリップボードにコピーする

前回の、Googleドライブにある画像の直リンク取得だが、
使用回数重ねるうちに思ったのは、いちいちダイアログからコピーするのが
億劫だってこと。

修正自体はリザルト先を入力ダイアログからクリップボード
変えるだけだし一先ず直してみる。
とは言え、これで使い易くなるのかどうかピンと来ないんだけども…。

尚、VBSでクリップボードへのコピーはここを参考にした。

clipコマンドを利用してクリップボードに文字列をコピーするVBScript | 初心者備忘録

動作はclipコマンドを使い実現しているので、
扱う文字列にコマンドプロンプトのエスケープ文字「 "|<>&」が
入り込まないことが約束されている場合のみ取り入れると良さ気。

仮にエスケープ文字を含む文字列をクリップボードにコピーしたいなら、
InternetExplorerオブジェクトを使ったこちらの解説が役立つだろう
(ソース見ると分かるが、力技なアプローチ。)。

クリップボードに文字列をコピーする | 初心者備忘録


●操作手順

1.Googleドライブにある画像を右クリック
2.「共有可能なリンクを取得」から表示されるリンクを選択してCtrl+Cでコピー
3.VBSを実行して直リンクをクリップボードへセット
4.クリップボードにコピーされた直リンクを貼り付ける等して使用


GoogleDriveCreatePermalink.vbs

Option Explicit

Const TITLE = "Googleドライブ画像、直リンク生成"
Const VERSION = "Ver1.10"
Const RELEASE = #2017/04/30#
Const AUTHOR = "REGEKATSU"

'元URL
Const SEARCH_TEXT = "https://drive.google.com/open?id="
'加工URL
Const REPLACE_TEXT = "https://drive.google.com/uc?id="
'完了メッセージ表示時間(秒)
Const WAIT_TIME = 5

Dim clipText
Dim putText

'クリップボードのテキストデータを確認する
clipText = GetClipboardText()

'クリップボードが空なら終了する
If IsNull(clipText) Then
    WScript.Echo "貼り付けるデータがありません。" & vbCrLf & _
        "とりあえず、何かコピーしてください。。。"
    WScript.Quit
    
'クリップボードに共有リンクが含まれていなければ終了する
ElseIf InStr(clipText, SEARCH_TEXT) <= 0 Then
    WScript.Echo "貼り付けるデータが正しくありません。" & vbCrLf & _
        "共有可能なリンクを取得からコピーしてください。。。"
    WScript.Quit
    
End If

'Googleドライブ内画像の共有可能なリンクから直リンクを生成する
putText = Replace(clipText, SEARCH_TEXT, REPLACE_TEXT)

'クリップボードへテキストデータをセットする
SetClipboardText putText

'完了メッセージを一定時間表示する
CreateObject("WScript.Shell").Run _
    "cmd /c echo " & TITLE & " " & VERSION & " & " & _
    "echo 共有可能なリンクから直リンクを生成しました。 & " & _
    "echo 直リンク: " & putText & " & " & _
    "echo; & " & _
    "echo ※この画面は " & WAIT_TIME & " 秒後に閉じます... & " & _
    "ping -n " & WAIT_TIME & " localhost > nul", 1

WScript.Quit


'サブルーチン

'クリップボードのテキストデータを取得する。なければNullを返す。
Function GetClipboardText()
    Dim objHTML
    Set objHTML = CreateObject("htmlfile")
    GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
    Set objHTML = Nothing
End Function

'クリップボードへテキストデータをセットする。
Sub SetClipboardText(ByVal str)
    Dim cmd
    cmd = "cmd /c ""echo " & str & "| clip"""
    CreateObject("WScript.Shell").Run cmd, 0, True
End Sub

Googleドライブにある画像の直リンクを生成する

Googleドライブに保存した画像から、
「共有可能なリンクを取得」でURLが得られるのだが
どうもGoogleの画像ビューア経由で表示されてしまい、
HTMLのIMGタグで指定することが出来なかった。

少し調べてみたところURLを加工することで直リンクもイケるらしい。

Google Driveに入れた画像を直接表示するパスを取得する。 - 亀岡的プログラマ日記

1枚2枚なら解説のとおり手作業でも問題無いんだが、
それ以上数をこなしてくとなると結構な手間になるのは目に見えているので、
加工を行うVBSを作ってみた。

VBSでクリップボードのテキスト取得はここら辺を参考にした。

VBScript でクリップボードのデータを扱う


●操作手順

1.Googleドライブにある画像を右クリック
2.「共有可能なリンクを取得」から表示されるリンクを選択してCtrl+Cでコピー
3.VBSを実行して直リンクを表示
4.表示された直リンクをコピー等して使用


GoogleDriveCreatePermalink.vbs

Option Explicit

Const TITLE = "Googleドライブ内画像 パーマリンク生成"
Const VERSION = "Ver1.00"
Const RELEASE = #2017/04/17#
Const AUTHOR = "DumBo"

Const SEARCH_TEXT = "https://drive.google.com/open?id="
Const REPLACE_TEXT = "https://drive.google.com/uc?export=view&id="

Dim clipText
Dim putText

'クリップボードのテキストデータ確認
clipText = GetClipboardText()

'クリップボードが空なら終了する
If IsNull(clipText) Then
    WScript.Echo "貼り付けるデータがありません。" & vbCrLf & _
        "とりあえず、何かコピーしてください。。。"
    WScript.Quit
    
'クリップボードに共有リンクが含まれていなければ終了する
ElseIf InStr(clipText, SEARCH_TEXT) <= 0 Then
    WScript.Echo "貼り付けるデータが正しくありません。" & vbCrLf & _
        "共有可能なリンクを取得からコピーしてください。。。"
    WScript.Quit
    
End If

'Googleドライブ内画像の共有可能なリンクからパーマリンクを生成する
putText = Replace(clipText, SEARCH_TEXT, REPLACE_TEXT)

Call InputBox("共有可能なリンクからパーマリンクを生成しました。" & vbCrLf & _
    "テキストボックスからコピーして使用してください。", _
    TITLE & " " & VERSION, putText)

WScript.Quit


'サブルーチン

'クリップボードにあるテキストデータを取得する。なければNullを返す。
Function GetClipboardText()
    Dim objHTML
    Set objHTML = CreateObject("htmlfile")
    GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
    Set objHTML = Nothing
End Function

ImageMagickで画像をリサイズ&コンテキストメニューに追加

蔵書管理で使う本の表紙画像を長辺250ピクセルとしてリサイズする用途のもの。

スキャンしたり拾ってきたりした画像は大概求めるよりもサイズが大きくてね。

以前はIrFanViewを開いてはポチポチと縮小していたものだが、
ImageMagickならコマンドラインから呼び出せると聞いたので、
蔵書登録作業における部分最適化を試みたという次第。

リサイズルーチンは下記を参考に、やや追記加えた感じで使用中。

長辺の長さを一定にして画像を一括リサイズするbatを書いた - Qiita

同じディレクトリのpng画像を長辺900pxにリサイズするbatファイル(http://qiita.com/smison/items/d32eb72be807e099dfa0) · GitHub

バッチ本体を配置するドライブとかフォルダは任意で対応を任すところ。
※実行にはImageMagickのインストールが必要


ImageMagickで画像をリサイズ

resize.bat

@echo off
REM Image Magick - 画像を長辺に合わせてリサイズ
REM version 0.01.2
REM 2016/09/10
REM by.REGEKATSU

REM 変換後の長辺サイズを設定
set RESIZE=250

REM 画像名のサフィックスを設定
set SUFFIX=_resized

REM 出力画像形式オプション
REM 0=元と同じ画像形式, 1=全て指定した画像形式
set OUT_OPTION=1

REM 出力画像形式の指定
set OUT_EXT=.png

REM 引数の分だけ処理を実行
:loop
if "%~1"=="" goto end

REM 出力画像形式が元画像と同じ場合
if %OUT_OPTION%==0 set OUT_EXT=%~x1

REM 入力画像の拡張子を小文字に変換
set IN_EXT=%~x1
for %%i in (a b c d e f g h i j k l m n o p q r s t u v w x y z) do call set IN_EXT=%%IN_EXT:%%i=%%i%%

REM 入力が画像であるか確認
set IS_TRUE=FALSE
if %IN_EXT%==.bmp set IS_TRUE=TRUE
if %IN_EXT%==.tif set IS_TRUE=TRUE
if %IN_EXT%==.tiff set IS_TRUE=TRUE
if %IN_EXT%==.jpg set IS_TRUE=TRUE
if %IN_EXT%==.jpeg set IS_TRUE=TRUE
if %IN_EXT%==.gif set IS_TRUE=TRUE
if %IN_EXT%==.png set IS_TRUE=TRUE

if %IS_TRUE%==TRUE (
setlocal enabledelayedexpansion

  REM 画像の縦幅を取得
  for /f "usebackq tokens=*" %%i in (`identify -format '%%h' %1`) do @set HEIGHT=%%i

  REM 画像の横幅を取得
  for /f "usebackq tokens=*" %%i in (`identify -format '%%w' %1`) do @set WIDTH=%%i

  REM 幅情報に含まれる前後の「'」を除去
  @set WIDTH=!WIDTH:~1,-1!
  @set HEIGHT=!HEIGHT:~1,-1!

  if !HEIGHT! GEQ !WIDTH! (
    REM 縦幅>=横幅
    convert -resize x%RESIZE% %1 "%~dpn1%SUFFIX%%OUT_EXT%"
  ) else (
    REM 縦幅<横幅
    convert -resize %RESIZE%x %1 "%~dpn1%SUFFIX%%OUT_EXT%"
  )

REM 処理を行った画像情報を表示
echo %1%~n1%SUFFIX%%OUT_EXT%、長辺 %RESIZE%px にリサイズ
)

REM 次の引数へシフト
shift
goto loop

:end


コンテキストメニューに追加
レジストリはresize.batが以下パスにあるとした場合のもの
C:\regekatsu\utility\ImageMagick\resize.bat

ImageMagickで画像をリサイズ.reg

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\*\shell]

[HKEY_CLASSES_ROOT\*\shell\imagemagickresize]
@="ImageMagickで画像をリサイズ(&I)"

[HKEY_CLASSES_ROOT\*\shell\imagemagickresize\command]
@="\"C:\\regekatsu\\utility\\ImageMagick\\resize.bat\" \"%1\""

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