« | »

2010.09.23

ScanSnapで自炊した電子書籍を一気に縮小・圧縮するスクリプト作ってみた

ScanSnapでの自炊は順調なんですが、一々モバイル用にサイズ縮小して無圧縮ZIPで固めてというのが少々面倒ではありますので、少しでも楽にしようとスクリプト組んでみました。
自分の環境用なので汎用ではないですが、参考になれば。
ひっさびさにスクリプトとかやった上に動けばいい、の精神なので無駄な処理とかも多いと思いますが生暖かい目で見てやってくださいw
修正はご自由に。
必要なもの(Windows7 32bit/WindowsXPで動作確認。64bitとかで動かないときは自力で何とかしてくださいw)
・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で横に取り込んだ際に一括で回転させることも可能。
トリミングとかはやってないですがビューアー側で適切に縮小・拡大表示すればおk。
または「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

実行には時間かかるわ何も進行状況とかでないわの不親切仕様ですw
強制停止したければタスクでwscript止めればおk。

にほんブログ村 PC家電ブログ デジモノへ
にほんブログ村


Related Articles:

 

Comment & Trackback

Comments and Trackback are closed.

No comments.