「電子書籍のサービス終了に備える」（第5回）楽天Kobo (2)PDF化編

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

はじめに

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

今回は、楽天の電子書籍（楽天Kobo）のPDF化（前回記事でキャプチャしたPNGをPDFにする方法）について記載します。

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

キャプチャした画像サイズから切り抜き位置とサイズを計算します。

PDF化を行う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_kobo_comic.vbs)

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

メモ帳で保存する場合

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

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

3.名前を付けて保存で、ファイル名にpng2pdf_kobo_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")

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

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

Call InitEBook()

' 最初と最後の画像については、中央１ページか左右２ページかを確認
If MsgBox("最初の画像は１ページですか？", 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("最後の画像は１ページですか？", 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
        ' 中央の１ページを抽出 （★↓座標は変更要）
        cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+393+1! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
        ret = objShell.Run(cmd, 0, TRUE)
    Else
        ' 左右の２ページを抽出 （★↓座標は変更要）
        cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+787+1! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
        ret = objShell.Run(cmd, 0, TRUE)

        cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+1+1! " + 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 & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)

Call QuitScript(2)

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

文庫本のPDF化png2pdf_kobo_novel.vbs)

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

メモ帳で保存する場合

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

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

3.名前を付けて保存で、ファイル名にpng2pdf_kobo_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")

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

Dim idx
Dim fname
Dim cmd
Dim ret

Call InitEBook()

For idx = 0 To (num_img_files - 1)
    fname = img_filelist(idx)
    WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"
    ret = CopyFileOverWrite(fname, EBOOK_PAGES_DIR + "/" & fname)
Next

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

Call QuitScript(2)

スクリプトの実行

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

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

スポンサーリンク

コメント

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