2010.09.23
ScanSnapで自炊した電子書籍を一気に縮小・圧縮するスクリプト作ってみた
ScanSnapでの自炊は順調なんですが、一々モバイル用にサイズ縮小して無圧縮ZIPで固めてというのが少々面倒ではありますので、少しでも楽にしようとスクリプト組んでみました。
自分の環境用なので汎用ではないですが、参考になれば。
ひっさびさにスクリプトとかやった上に動けばいい、の精神なので無駄な処理とかも多いと思いますが生暖かい目で見てやってくださいｗ
修正はご自由に。
必要なもの(Windows7 32bit/WindowsXPで動作確認。64bitとかで動かないときは自力で何とかしてくださいｗ)
・ImageMagick
http://www.imagemagick.org/script/binary-releases.php?ImageMagick=u0c8al9mvprindtgdftvrjfsh5#windows
ImageMagick-6.6.4-0-Q16-windows-dll.exe
インストール時にDLL登録してください。
インストール時にチェック忘れたら以下を実行。
C:WindowsSystem32regsvr32.exe “C:Program FilesImageMagick-6.6.4-Q16ImageMagickObject.dll”
・ZipBasket
http://ubichupas.blogspot.com/2010/05/zipbasket140.html
ZipBasket.zipを解凍、任意の場所に設置。
超便利です。開発者のubichupasさまに感謝。
ScanSnapでJPEGスキャンしたりPDFをJPEG変換したりした際、そのフォルダをフルパスでリスト化しておきます。
後はパラメータ設定してスクリプト実行すればリスト内のパスのフォルダ内JPEGを一気にリサイズして指定パスに無圧縮ZIPで固めるところまでやるようにしました(圧縮しない指定も可能)。
また、ScanSnapで横に取り込んだ際に一括で回転させることも可能。
トリミングとかはやってないですがビューアー側で適切に縮小・拡大表示すればおｋ。
または「eTilTran」使うと小説とかは楽に読みやすくトリミングできますのでオススメ。
解像度調整すればiPhone用でもPC用でも自由にできます。
そのほか、ImageMagicのパラメータいじればサイズも画質も自分好みにできそうなんで使う際には調整してください。
以下のテキストを.vbsとして保存してください。
| ‘********************************** ‘*複数スキャンデータを無圧縮zip化 ‘********************************** Option Explicit On error resume next Dim objFSO,objShell,objImg,objtxtFile,objFolder,objFile Dim intFlgRotate,intFlgRotate2,intFlgZip Dim strListPath Dim strFolder Dim strZipPath Dim strPathName,strFileName Dim strSavePath,strDstPath Dim strCommand1 Dim strResize,strUnsharp,strColor,strQuality Dim strRotate1,strRotate2 Dim intFileNo Dim i ‘回転処理モード(2=回転処理のみ/1=回転・縮小処理する/0=回転処理しない) intFlgRotate =1 ‘回転方向(2=奇数ページで左側が上/1=奇数ページで右側が上) intFlgRotate2 =1 ‘圧縮処理モード(1=ZIP圧縮する/0=ZIP圧縮しない) intFlgZip =0 ‘処理対象リストファイル strListPath =”C:MyScriptsDirList.txt” ‘保存先フォルダ ‘strSavePath =”C:Common0_book” strSavePath =”C:0_BooksFilecomic” ‘ZipBasketのパス strZipPath =”C:UtilityZipBasketZipBasket.exe” ‘各パラメータ ‘生成するサイズ ‘strResize =”x854″ ‘–SH-03B縦854pix ‘strResize =”854x” ‘–SH-03B横854pix ‘strResize =”x960″ ‘–iPhone4縦960pix ‘strResize =”960x” ‘–iPhone4横960pix ‘strResize =”x1280″ ‘–LOOX U用縦1280pix ‘strResize =”1280x” ‘–LOOX U用横1280pix strResize =”x1400″ ‘–PC用縦1400pix strUnsharp =”2×1.4+0.5+0″ strColor =”64″ strQuality =”90″ ‘回転方向(下一桁が偶数なら右回転、奇数なら左回転) if intFlgRotate2=1 then ‘1ページ目で右側が上 strRotate1 =”-90″ strRotate2 =”+90″ else ‘1ページ目で左側が上 strRotate1 =”+90″ strRotate2 =”-90″ end if ‘各オブジェクト Set objFSO =WScript.CreateObject(“Scripting.FileSystemObject”) Set objShell =WScript.CreateObject(“WScript.Shell”) Set objImg =CreateObject(“ImageMagickObject.MagickImage.1”) ‘カウンタ初期化 i=0 ‘ファイルリスト読み込み Set objtxtFile =objFSO.OpenTextFile(strListPath) If Err.Number<>0 Then MsgBox(“リストファイルオープンエラー: ” & Err.Description) Else Do While objtxtFile.AtEndOfStream<>True strFolder=”” strFolder=objtxtFile.ReadLine ‘対象フォルダの存在チェック If objFSO.FolderExists(strFolder) =True Then Set objFolder =objFSO.GetFolder(strFolder) ‘フォルダ名取得 strPathName=objFolder.Name ‘縮小画像入れるフォルダ名を生成 strDstPath=strSavePath & strPathName & “_” & strResize ‘生成先のファイル･フォルダを削除 DeleteFolder(strDstPath) DeleteFile(strDstPath) ‘書き出し先フォルダ配下に元フォルダ名+sで一時フォルダ作成 objFSO.CreateFolder(strDstPath) If Err.Number<>0 Then MsgBox(“エラー: ” & Err.Description) End If ‘指定ディレクトリ配下のファイル一覧取得・縮小処理 For Each objFile In objFolder.Files ‘拡張子jpg、png以外は対象外 if Right(objFile.Name, 4) =”.jpg” or Right(objFile.Name, 4) =”.png” then ‘「～s.jpg」を書き出し先フォルダに縮小して出力 strFileName=Replace(CStr(objFile.Name),”.jpg”,”_s.jpg”) strFileName=Replace(CStr(objFile.Name),”.png”,”_s.jpg”) if intFlgRotate>0 then intFileNo=0 intFileNo=Cint(Left(Right(objFile.Name, 5),1)) if intFlgRotate =2 then ‘回転のみ if intFileNo Mod 2 =1 then objImg.Convert “-rotate”,strRotate1, objFile.Path, strDstPath & “” & strFileName else objImg.Convert “-rotate”,strRotate2, objFile.Path, strDstPath & “” & strFileName end if elseif intFlgRotate =1 then ‘回転・縮小 if intFileNo Mod 2 =1 then objImg.Convert “-rotate”,strRotate1,”-resize”, strResize,”-unsharp”,strUnsharp,”-colors”,strColor,”-quality”,strQuality, objFile.Path, strDstPath & “” & strFileName else objImg.Convert “-rotate”,strRotate2,”-resize”, strResize,”-unsharp”,strUnsharp,”-colors”,strColor,”-quality”,strQuality, objFile.Path, strDstPath & “” & strFileName end if end if else ‘回転処理なし objImg.Convert “-resize”, strResize,”-unsharp”,strUnsharp,”-colors”,strColor,”-quality”,strQuality, objFile.Path, strDstPath & “” & strFileName end if If Err.Number<>0 Then MsgBox(“エラー: ” & Err.Description) exit do End If end if Next ‘ループ終了 if intFlgZip=1 then ‘書き出し先フォルダを無圧縮ZIPで固める strCommand1=”” strCommand1=strZipPath & ” ” & “””” & strDstPath & “.zip” & “””” & ” ” & “””” & strDstPath & “””” objShell.Run strCommand1,1,True If Err.Number<>0 Then MsgBox(“エラー: ” & Err.Description) exit do End If ‘書き出し先一時フォルダ削除 DeleteFolder(strDstPath) end if end if i=i+1 if i>1000 then MsgBox(“ループオーバー”) exit do end if Loop objtxtFile.Close End If Set objImg =Nothing Set objShell =Nothing Set objFolder=Nothing Set objFSO =Nothing Set objtxtFile=Nothing MsgBox “縮小圧縮処理終了” sub DeleteFolder(ByVal strDstPath) If objFSO.FolderExists(strDstPath) =True Then objFSO.DeleteFolder(strDstPath) If Err.Number<>0 Then MsgBox(“エラー: ” & Err.Description) End If end if End Sub sub DeleteFile(ByVal strDstPath) If objFSO.FileExists(strDstPath & “.zip”) =True Then objFSO.DeleteFile(strDstPath & “.zip”) If Err.Number<>0 Then MsgBox(“エラー: ” & Err.Description) End If end if End Sub |
実行には時間かかるわ何も進行状況とかでないわの不親切仕様ですｗ
強制停止したければタスクでwscript止めればおｋ。
Comment & Trackback