robocopy コマンドで簡易バックアップの仕組みを用意する
先週末にメインで使っていたPCが大破。
微妙なマシンは幾らか有していた為、
そのうちのスティックPCで暫しの間過ごす事に。
データ関連は外付け USB HDD への保存を基本としていたので
移行作業自体は接続の変更だけで終了したのだが、
タスク登録していたバックアップバッチはシステムドライブ上に在り
直ぐ取り出す事も侭ならず、仕方ないので書き直すことにした。
書き直すとは言っても、実際のところ今までのバッチが
融通聞かない代物だったので、リファインの切っ掛けとしては
丁度良かった気もする。
想定する利用シーンに基づき、2 つの実行ウィザードと
1 つの実行バッチを追加。
前に書いたものよりかは大分マシなものになったと思う。
実際のスクリプトは以下。
俺俺感ぱないけど、何かの参考になれば幸いである。
(1)バッチ HDD バックアップ
設定ファイルに記述されたドライブに対してバックアップ処理を実行。
BatchHDDBackup.bat
@echo off set cfg_name=%~n0 set cfg_ext=.ini set cfg_file=%cfg_name%%cfg_ext% if not exist "%cfg_file%" ( echo コンフィグファイル %cfg_file% が見つかりません。 echo ; %cfg_name% configuration>%cfg_file% echo [directory]>>%cfg_file% echo src=>>%cfg_file% echo dst=>>%cfg_file% echo コンフィグファイル %cfg_file% を作成しました。 echo; echo 'src=' 以降にバックアップ元ドライブまたはフォルダを、 echo 'dst=' 以降にバックアップ先ドライブまたはフォルダを、 echo フルパスで指定してください。 echo; echo なお、パスの指定に前後「"」または末尾「\」を含めないでください。 echo 上記記号が混入してると正しく動作しません。 echo; echo 例:） echo src=Z: echo dst=Y: echo; exit /b ) rem コンフィグファイル %cfg_file% は既に存在します。 rem バックアップ元ドライブ for /f "eol=; tokens=1* delims==" %%a in ('find "src" %cfg_file%') do (set src=%%b) rem バックアップ先ドライブ for /f "eol=; tokens=1* delims==" %%a in ('find "dst" %cfg_file%') do (set dst=%%b) call HDDBackup.bat "%src%" "%dst%" exit /b
BatchHDDBackup.ini
; BatchHDDBackup configuration [directory] src=Z: dst=Y:
タスクスケジューラに登録して定期実行することを想定。
壊れた PC で主に利用していた動作。
(2)カレント HDD バックアップ
カレントドライブを元、選択したドライブを先としてバックアップ処理を実行。
CurrentHDDBackup.bat
@echo off set src=%~d0 echo カレントドライブ %src% をバックアップします。 vol %src% echo; set dst=0 set /p dst="バックアップ先ドライブを入力してください . . . " rem 指定されたドライブが見つかりません。 set is_exist=0 for /f "usebackq tokens=*" %%i in (`vol %dst% ^| find "ラベル" /C`) do (set is_exist=%%i) if %is_exist%==0 goto END vol %dst% echo; set yesno=n set /p yesno="バックアップを開始しますか?(y/n) . . . " if not "%yesno:y=y%"=="y" goto END call HDDBackup.bat "%src%" "%dst%" echo; echo バックアップが終了しました。 pause exit /b :END echo; echo バックアップを中止しました。 pause exit /b
今回一番欲しかったもの。別 PC にドライブを移した際、
即時使えるものを求めていた。
こいつがメイン、バックアップの両方に入っていれば
仮に一方が壊れた場合でも、新調したドライブへのリストアが容易に行えるって寸法。
(3)セレクト HDD バックアップ
始めに選択したドライブを元、後に選択したドライブを先としてバックアップ処理を実行。
SelectHDDBackup.bat
@echo off echo 選択したドライブをバックアップします。 echo; set src=0 set /p src="バックアップ元ドライブを入力してください . . . " rem 指定されたドライブが見つかりません。 set is_exist=0 for /f "usebackq tokens=*" %%i in (`vol %src% ^| find "ラベル" /C`) do (set is_exist=%%i) if %is_exist%==0 goto END vol %src% echo; set dst=0 set /p dst="バックアップ先ドライブを入力してください . . . " rem 指定されたドライブが見つかりません。 set is_exist=0 for /f "usebackq tokens=*" %%i in (`vol %dst% ^| find "ラベル" /C`) do (set is_exist=%%i) if %is_exist%==0 goto END vol %dst% echo; set yesno=n set /p yesno="バックアップを開始しますか?(y/n) . . . " if not "%yesno:y=y%"=="y" goto END call HDDBackup.bat "%src%" "%dst%" echo; echo バックアップが終了しました。 pause exit /b :END echo; echo バックアップを中止しました。 pause exit /b
カレントバックアップのついでに書いたもの。
過去何回かメインデータの方を誤って削除して、
その度にリストアで不便を伴っていたのも事実なので、
有るに越したことはないと思う。
(4)HDD バックアップ
処理本体。robocopy コマンドでバックアップ処理を実行。
HDDBackup.bat
@echo off rem バックアップ元ドライブ if "%~1"=="" goto END set src=%~1 rem バックアップ先ドライブ if "%~2"=="" goto END set dst=%~2 set root_dir=Regekatsu set sub_dir=Backup set log_dir=log set save_dir=%SystemDrive%\%root_dir%\%sub_dir%\%log_dir% md "%save_dir%" set dt=%date% set tm=%time% set dt=%dt:~0,4%-%dt:~5,2%-%dt:~8,2% set tm=%tm:~0,2%-%tm:~3,2%-%tm:~6,2% set tm=%tm: =0% set log_dttm=%dt%_%tm% set log_prefix=Backup_ set log_ext=.log set log_file="%save_dir%\%log_prefix%%log_dttm%%log_ext%" setlocal cd \ robocopy "%src%" "%dst%" /MIR /R:0 /W:0 /LOG:"%log_file%" /NP /NDL /TEE endlocal exit /b :END echo usage: %~nx0% バックアップ元ドライブ バックアップ先ドライブ exit /b
実行ログの保存先。これは決め打ち。
%SystemDrive%\Regekatsu\Backup\log
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というアーカイバが入っている前提。
VB、VBAだと割かし実装例が出て来るのだけど、
やはりというか、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
VBScript で API 呼び出し ( ソフトウェア ) - 特になし - 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新作で少しだけお手伝いをした。
コーディングじゃなくデバッグ要員として。
エミュや実機検証はタクトさん本人が
開発と並行で随時していたので、
自分は主にレトロフリークでの動作検証をば。
粗方のバグや不具合も取れたという事で、
既にプレス業者に入稿済みだそうな。
この「巫女ぱら」という作品自体は
初出2005年の結構前に出されたタイトルであり、
今回そのリファイン版と言うべきものではあるが。
フルボイス化が成されたり、画面効果が増強されたり、
細かい作り込みや、パッケージが一新された等、
かなり本気で取り組まれている様子。
もし気になるようであれば当日サークルスペースに足を運んで、
見て貰えると宜しいかも知れない。
コミックマーケット92 1日目（金曜日） 東地区 す-42b CUBIC STYLE
また、別枠ではあるが巫女ぱらのボイス集が
音声を担当された夢前黎様より DLSite.com にて
同日販売開始される模様。
こちらも併せてチェックするとより良いかと。
それと手前味噌で申し訳ないが。
巫女ぱら繋がりということで。。
先日 Pebble 用ウォッチフェイスをジェネレータで作ってみたので、
持ってる人は気が向いたときにでも使ってくれると嬉しいかも。
Pebble用に巫女ぱらWatchfaceを作ってみるテスト。時分の文字色何パターンか試したけど水色が一番視認性あるな pic.twitter.com/jLWhmrceea
— DumBo@レゲ活 (@regekatsu) 2017年7月30日
※ダウンロードはこちらから
Pebble watchface "mikopara" - by https://t.co/bKjK9srLKR https://t.co/SIRr7mNBlu
— DumBo@レゲ活 (@regekatsu) 2017年8月8日
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でクリップボードのテキスト取得はここら辺を参考にした。
●操作手順
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商品コード] [...]]
しばらくすると取得結果が標準出力に表示される。
(複数指定した場合、結果出力が以降も繰り返し表示される。)
引数無しで実行した場合、
「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 ０～９: &H824F～&H8258 'または Ａ～Ｚ: &H8260～&H8279 だった場合 retChar = Chr(tempCode + SHIFT_CODE) ElseIf tempCode >= &H8281 And tempCode <= &H829A Then '文字コードが Shift_JIS ａ～ｚ: &H8281～&H829A だった場合 retChar = Chr(tempCode + SHIFT_CODE - 1) Else '文字コードが変換対象外だった場合 retChar = tempChar End If retStr = retStr & retChar Next StrConvNarrow = retStr End Function
英数文字列を半角または全角に変換
VB、VBAだとStrConvという便利な関数が使えるのだが、
VBSに該当または同等の関数が無い為作ってみた。
英数のみで言えば文字コードを一定量シフトさせることで
半角または全角変換は難なく実現した。
記号及びカタカナに関してはシフトJISの場合
文字の並びに類似性が無く、
煩雑な実装が必要だったので非対応とした。
(1文字づつ判定して処置してく事になる。)
当初の目的が自作VBSで受け取った
ASIN/ISBNの全角文字列を半角に変換だったから、
これはこれで良しとする。
(余談だが、追加インストールを厭わなければ、
BASP21.DLLを導入することで、
COMコンポーネントからStrConvが使える模様。)
英数全半角変換.vbs
Option Explicit 'ASCII <-> Shift_JIS 文字コード変換補数 Const SHIFT_CODE = &H7DE1 Dim input '全角英数→半角変換テスト input = InputBox("全角英数を半角に変換します。", "全角英数を半角に変換") WScript.Echo "入力: " & input & vbCrLf & _ "出力: " & StrConvNarrow(input) '半角英数→全角変換テスト input = InputBox("半角英数を全角に変換します。", "半角英数を全角に変換") WScript.Echo "入力: " & input & vbCrLf & _ "出力: " & StrConvWide(input) 'サブルーチン '指定した文字列の全角英数を半角に変換して返す 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 ０～９: &H824F～&H8258 'または Ａ～Ｚ: &H8260～&H8279 だった場合 retChar = Chr(tempCode + SHIFT_CODE) ElseIf tempCode >= &H8281 And tempCode <= &H829A Then '文字コードが Shift_JIS ａ～ｚ: &H8281～&H829A だった場合 retChar = Chr(tempCode + SHIFT_CODE - 1) Else '文字コードが変換対象外だった場合 retChar = tempChar End If retStr = retStr & retChar Next StrConvNarrow = retStr End Function '指定した文字列の半角英数を全角に変換して返す Function StrConvWide(strNarrow) Dim length, index, retStr, retChar, tempChar, tempCode retStr = "" StrConvWide = retStr length = Len(strNarrow) For index = 1 To length tempChar = Mid(strNarrow, index, 1) tempCode = Asc(tempChar) If (tempCode >= &H30 And tempCode <= &H39) Or _ (tempCode >= &H41 And tempCode <= &H5A) Then '文字コードが ASCII 0～9: &H30～&H39 'または A～Z: &H41～&H5A だった場合 retChar = Chr(tempCode - SHIFT_CODE) ElseIf tempCode >= &H61 And tempCode <= &H7A Then '文字コードが ASCII a～z: &H61～&H7A だった場合 retChar = Chr(tempCode - SHIFT_CODE + 1) Else '文字コードが変換対象外だった場合 retChar = tempChar End If retStr = retStr & retChar Next StrConvWide = retStr End Function
