「電子書籍のサービス終了に備える」(第3回)Kindle (2)PDF化編

電子書籍サービス終了 電子書籍

はじめに

本記事の目的についてはこの連載の初回記事を見てください。

今回は、Amazonの電子書籍(Kindle)のPDF化(前回記事でキャプチャしたPNGをPDFにする方法)について記載します。

画像の切り抜き位置とサイズ

キャプチャしたPNGから各ページを切り抜くには切り抜き位置(XY座標)とサイズ(幅、高さ)が必要です。

まず、ペイントでキャプチャしたPNGを開き、左上と右下の座標を調べます。

Kindle表示サイズ

下記画像のように、①拡大→②マウスカーソルの位置合わせ→③左下に表示されている座標確認を行ってください。

Kindle左上座標

左上(X1, Y1)と右下(X2, Y2)が分かれば、幅は(X2 – X1)、高さは(Y2 – Y1) となります。コミックのように左右2ページある場合は、幅を半分にして、右側ページの切り抜き位置は(X1+幅、Y1)となります。

画像切り抜きとPDF化を行うVBSスクリプト

python にするか ruby にするかWSLのbashにするか、いろいろ迷いましたが新たにインストール作業が必要なものは使ってもらえない気がしたので、少し面倒でしたがインストール不要のVBSで作成しました。

共通部(ebook_funcs.vbs)

下記スクリプトを任意のフォルダ(私は C:\tools\ebook にしています)に、ebook_funcs.vbs として保存してください。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。

メモ帳で保存する場合

1.下記ソースの右上をクリック(クリップボードにコピーされます)

2.メモ帳を起動し貼り付け

3.名前を付けて保存で、ファイル名にebook_funcs.vbsを入力、エンコードはANSIを選択し保存

Option Explicit

Dim objFso
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

Dim objShell
Set objShell = CreateObject("WScript.Shell")

' 呼び出し元が cscript(CUI) か wscript(GUI) か判断
Function IsGUI()
    Dim wshname

    wshname = LCase(Right(WScript.FullName, 11))
    If wshname = "cscript.exe" Then
        IsGUI = False
    Else
        IsGUI = True
    End If
End Function

' GUI 呼び出しなら CUI で呼びなおす
If IsGUI() Then
    WScript.CreateObject("WScript.Shell").Run("cscript //NoLogo """ & WScript.ScriptFullName & """" & " /rerun:1")
    WScript.Quit
End If

' 最初からCUIで実行されたか、GUI実行後CUIで実行されたかの判断
Dim gui_cui_re_run
Dim args
Set args = WScript.Arguments
If args.Named.Exists("rerun") = True Then
    gui_cui_re_run = True
Else
    gui_cui_re_run = False
End If

' スクリプト終了。GUI実行後CUIで実行された場合は、エラーメッセージ等を読めるように少し待ってから終了する
Sub QuitScript(sleep_sec)
    If gui_cui_re_run Then WScript.Sleep 1000 * sleep_sec
    WScript.Quit
End Sub

' フォルダ作成
Function CreateFolderEx(ByVal folder)
    Dim result

    Dim parent_dir
    parent_dir = objFso.GetParentFolderName(folder)

    result = True
    If parent_dir <> "" Then
        If objFso.FolderExists(parent_dir) = False Then
            result = CreateFolderEx(parent_dir)
        End If
    End If

    If result Then
        If Not objFso.FolderExists(folder) Then
            objFso.CreateFolder(folder)
        End If
    End If

    If objFso.FolderExists(folder) Then
        CreateFolderEx = True
    Else
        CreateFolderEx = False
    End If
End Function

' バブルソート(ソートがvbs標準に無いので自作)
Sub swap(ByRef x, ByRef y)
    Dim d
    d = x
    x = y
    y = d
End Sub
Sub SortBubble(ByRef a)
    Dim i
    For i = 0 To UBound(a) - 1
        Dim j
        For j = i + 1 To UBound(a)
            If StrComp(a(j), a(i)) < 0 Then
                Call swap(a(i), a(j))
            End If
        Next
    Next
End Sub

' ファイル一覧取得([topfoldername] にある、拡張子[ext] のファイル一覧を [filelist] に取得)
Function FindFiles(ByVal topfoldername, ByVal ext, ByRef filelist)
    Dim num_files
    num_files = 0

    If Not objFso.FolderExists(topfoldername) Then
        FindFiles = num_files
        Exit Function
    End If

    Dim topfolder
    Set topfolder = objFso.GetFolder(topfoldername)

    Dim subdir
    Dim file

    Dim select_flg
    Dim idx
    idx = UBound(filelist)
    For Each file In topfolder.Files
        select_flg = True
        If ext <> "" Then
            ' 拡張子が引数extと一致するファイルのみ
            If UCase(objFso.GetExtensionName(file.Name)) = UCase(ext) Then
                select_flg = True
            End If
        End If

        If select_flg Then
            ReDim Preserve filelist(idx)
            filelist(idx) = file.Name
            idx = idx + 1
            num_files = num_files + 1
        End If
    Next

    If num_files >= 2 Then
        Call SortBubble(filelist)
    End If

    FindFiles = num_files
End Function

' 指定したフォルダと、そのフォルダ内の全てのファイルを削除
Function DeleteFolderFiles(ByVal folder_name)
    On Error Resume Next
    If objFso.FolderExists(folder_name) Then
        objFso.DeleteFolder folder_name, True
    ElseIf objFso.FileExists(folder_name) Then
        objFso.DeleteFile folder_name, True
    End If
    On Error Goto 0

    If objFso.FolderExists(folder_name) Or objFso.FileExists(folder_name) Then
        DeleteFolderFiles = False
    Else
        DeleteFolderFiles = True
    End If
End Function

' ファイルコピー(コピー先フォルダ作成、既存ファイルは上書き)
Function CopyFileOverWrite(ByVal from_file_name, ByVal to_file_name)
    CopyFileOverWrite = False

    If objFso.FileExists(from_file_name) = False Then
        ' 元ファイルがない
        Exit Function
    End If

    On Error Resume Next
    ' コピー先の親フォルダを作成
    If CreateFolderEx(objFso.GetParentFolderName(to_file_name)) Then
        Err.Clear
        objFso.CopyFile from_file_name, to_file_name, True
        If Err.Number = 0 Then
            CopyFileOverWrite = True
        End If
    End If
    Err.Clear
    On Error Goto 0
End Function

'-------------------------------------------------------------------------------

' ImageMagick コマンド (★↓パス変更要)
Const MAGICK_CMD = "C:\Program Files\ImageMagick-7.1.0-Q16-HDRI\magick.exe"
Dim CONVERT_CMD
CONVERT_CMD = """" + MAGICK_CMD + """ convert"

' キャプチャ画像の出力先フォルダ (★↓パス変更要)
Const CAPTURE_DIR = "C:\tools\WinShot\output"

' CAPTURE_DIR の下に作成する作業用フォルダ
Const EBOOK_PAGES_DIR = "ebook_pages"

Dim img_filelist()
Dim num_img_files

' 初期処理
Sub InitEBook()
    If objFso.FolderExists(CAPTURE_DIR) = False Then
        WScript.Echo "[" + CAPTURE_DIR +  "] フォルダが見つかりません"
        Call QuitScript(2)
    End If

    If objFso.FileExists(MAGICK_CMD) = False Then
        WScript.Echo "[" + MAGICK_CMD +  "] コマンドが見つかりません"
        Call QuitScript(2)
    End If

    objShell.CurrentDirectory = CAPTURE_DIR
    WScript.Echo objShell.CurrentDirectory

    ReDim Preserve img_filelist(0)
    num_img_files = FindFiles(".", "PNG", img_filelist)
    If num_img_files <= 0 Then
        WScript.Echo "[" + CAPTURE_DIR +  "] PNGファイルがありません"
        Call QuitScript(2)
    End If

    DeleteFolderFiles(EBOOK_PAGES_DIR)
    CreateFolderEx(EBOOK_PAGES_DIR)
End Sub

スクリプト中の★については環境によって変更する箇所です。

コミック本のPDF化(png2pdf_kindle_comic.vbs)

下記スクリプトを共通部(ebook_funcs.vbs)と同じフォルダに、png2pdf_kindle_comic.vbs として保存してください。。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。

メモ帳で保存する場合

1.下記ソースの右上をクリック(クリップボードにコピーされます)

2.メモ帳を起動し貼り付け

3.名前を付けて保存で、ファイル名にpng2pdf_kindle_comic.vbsを入力、エンコードはANSIを選択し保存

Option Explicit

' ebook_funcs.vbs を include
Sub Include(ByVal vbsfilename)
    Dim objFSO, objStream

    On Error Resume Next
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 
    Dim vbsfilepath
    vbsfilepath = objFSO.GetFile(WScript.ScriptFullName).ParentFolder & "\" & vbsfilename
    If objFSO.FileExists(vbsfilepath) Then
        Err.Clear
        Set objStream = objFSO.OpenTextFile(vbsfilepath, 1)
        If Err.Number = 0 Then
            ExecuteGlobal objStream.ReadAll()
            objStream.Close 
        End If
    End If
    On Error Goto 0
    Set objStream = Nothing 
    Set objFSO = Nothing
End Sub
Call Include("ebook_funcs.vbs")

'-------------------------------------------------------------------------------

Call InitEBook()

Dim num_page
Dim idx
Dim fname
Dim basename
Dim cmd
Dim first_one_page
Dim last_one_page
Dim ret

' 最初と最後の画像については、中央1ページか左右2ページかを確認
If MsgBox("最初の画像は1ページですか?", vbYesNo, "ページ数確認") = vbYes Then
    first_one_page = True
Else
    first_one_page = False
End If

If (num_img_files >= 2) Then
    ' 画像ファイルが複数あれば「最後」のページ数を確認
    WScript.Sleep 300

    If MsgBox("最後の画像は1ページですか?", vbYesNo, "ページ数確認") = vbYes Then
        last_one_page = True
    Else
        last_one_page = False
    End If
Else
    last_one_page = False
End If

For idx = 0 To (num_img_files - 1)
    fname = img_filelist(idx)
    basename = UCase(objFso.GetBaseName(fname))
    WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"

    ' 1画像のページ数(1 or 2) 設定
    num_page = 2
    If idx = 0 Then
        ' 最初
        If first_one_page Then
            num_page = 1
        Else
            num_page = 2
        End If
    End If
    If (num_img_files >= 2) Then
        If idx = (num_img_files - 1) Then
            ' 最後
            If last_one_page Then
                num_page = 1
            Else
                num_page = 2
            End If
        End If
    End If

    If num_page = 1 Then
        ' 中央の1ページを抽出 (★↓座標は変更要)
        cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+496+102! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
        ret = objShell.Run(cmd, 0, TRUE)
    Else
        ' 左右の2ページを抽出 (★↓座標は変更要)
        cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+872+102! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
        ret = objShell.Run(cmd, 0, TRUE)

        cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+122+102! " + EBOOK_PAGES_DIR + "/" & basename & "-2.PNG"
        ret = objShell.Run(cmd, 0, TRUE)
    End If
Next

objShell.CurrentDirectory = EBOOK_PAGES_DIR
WScript.Echo "PNG → PDF (しばらくお待ちください)"
' cmd = CONVERT_CMD & " *.PNG output.pdf"
cmd = CONVERT_CMD & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)

Call QuitScript(2)

スクリプト中の★については環境によって変更する箇所です。

ImageMagick convert コマンドの引数については、ImageMagick 画像(PNG)の切り抜き(crop)とPDF化 を参照してください。

文庫本のPDF化(png2pdf_kindle_novel.vbs)

下記スクリプトを共通部(ebook_funcs.vbs)と同じフォルダに、png2pdf_kindle_novel.vbs として保存してください。 ※Shift-JIS(CP932)で保存しないと正常に動作しないようです。

メモ帳で保存する場合

1.下記ソースの右上をクリック(クリップボードにコピーされます)

2.メモ帳を起動し貼り付け

3.名前を付けて保存で、ファイル名にpng2pdf_kindle_novel.vbsを入力、エンコードはANSIを選択し保存

Option Explicit

' ebook_funcs.vbs を include
Sub Include(ByVal vbsfilename)
    Dim objFSO, objStream

    On Error Resume Next
    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 
    Dim vbsfilepath
    vbsfilepath = objFSO.GetFile(WScript.ScriptFullName).ParentFolder & "\" & vbsfilename
    If objFSO.FileExists(vbsfilepath) Then
        Err.Clear
        Set objStream = objFSO.OpenTextFile(vbsfilepath, 1)
        If Err.Number = 0 Then
            ExecuteGlobal objStream.ReadAll()
            objStream.Close 
        End If
    End If
    On Error Goto 0
    Set objStream = Nothing 
    Set objFSO = Nothing
End Sub
Call Include("ebook_funcs.vbs")

'-------------------------------------------------------------------------------

Call InitEBook()

Dim idx
Dim fname
Dim cmd
Dim ret

For idx = 0 To (num_img_files - 1)
    fname = img_filelist(idx)
    WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"

    ' ページ抽出 (★↓座標は変更要)
    cmd = CONVERT_CMD & " " & fname & " -crop 668x897+96+117! " + EBOOK_PAGES_DIR + "/" & fname
    ret = objShell.Run(cmd, 0, TRUE)
Next

objShell.CurrentDirectory = EBOOK_PAGES_DIR
WScript.Echo "PNG → PDF (しばらくお待ちください)"
' cmd = CONVERT_CMD & " *.PNG output.pdf"
cmd = CONVERT_CMD & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)

Call QuitScript(2)

スクリプト中の★については環境によって変更する箇所です。

2023/1/20追記。最後のPNG→PDFコマンドにdensity と geometryのオプションを追記しました。SumatraPDF だとオプションなしでも正しく表示できたのですが、その他のViewerだと画面の一部しか表示できないという問題がありました。

ImageMagick convert コマンドの引数については、ImageMagick 画像(PNG)の切り抜き(crop)とPDF化 を参照してください。

スクリプトの実行

コミック本は png2pdf_kindle_comic.vbs、文庫本は png2pdf_kindle_novel.vbs をダブルクリックしてください。

キャプチャ保存フォルダの下の ebook_pages フォルダの下に、output.pdf が作成されます。

次回は楽天Koboのキャプチャを行います。

コメント

タイトルとURLをコピーしました