PDFファイルから任意のページを抽出してマージする

ある朝、職場の同僚から「様式(ページ構成)が同じPDFファイルが大量にあるんだが、2ページ目以降は不要なので、1ページ目だけを抽出して、1つのPDFファイルに結合・印刷できるようにしてもらえないか?」との依頼を受けた。

急な依頼だったので、とりあえず任意のフォルダに保存されているPDFファイルの1ページ目だけを抽出するバッチファイルを作って依頼者に渡し、なんとかその場を凌いだが・・・。

以前から Delphi でPDFファイルを操作する方法に関心があり、PDFを画像化するプログラムなどを書いてみたことがあったが、指定ページを抽出する方法や複数のPDFファイルを結合して1つにまとめる方法はわからないままだった。いい機会なのでちゃんと勉強してみることにした。これはその備忘録。

【もくじ】

1.使用するツール
2.指定ページを抽出
3.PDFファイルを結合
4.進捗状況も表示
5.まとめ
  エラー対策1・2を追記(20250211)
  プログラムコード
  PDFtkのインストールの有無を確認する方法を追記(20250218)
6.お願いとお断り

1.使用するツール

PDFファイルの抽出や結合を実行するために使用したのは「PDFtk Server」というコマンドラインから実行するツール。

PDF Labs
https://www.pdflabs.com/tools/pdftk-server/?form=MG0AV3

リンク先ページの中ほどに「Microsoft Windows」というタイトルがあり、「Click to download the PDFtk Server installer for Windows 10 and 11:」という説明の下に「Windows Download」があるので、これをクリックして「pdftk_server-2.02-win-setup.exe」(2025年2月9日現在)をダウンロードしてインストールしておく。

【インストール後、PATHの登録を必ず確認してください】

インストールしたら、システム環境変数のPATHに「pdftk.exe」までのパスが正しく登録されていることを必ず確認する。

「pdftk.exe」までのパスが正しく登録されていることを必ず確認してください。
(図は PDFtk の設定を変更せずにインストールした場合の設定です)


【重要な注意】

インストールした「pdftk.exe」までの PATH をシステム環境変数の PATH に登録せず、「プログラム内で文字列として指定」した場合、ここで紹介するプログラムコードは 動作しません!

2.指定ページを抽出

まず、GUIを作成。


exe のあるフォルダ内に src と dst という名称のフォルダも用意する。


指定ページを抽出する方法は、次の通り。

  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);

implementation

uses
  Winapi.ShellAPI, System.IOUtils;

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  InputDir, OutputDir: string;
  strMsg: string;
begin
  if ComboBox1.Text = '' then
  begin
    strMsg := '抽出するページを指定してください';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONSTOP);
    ComboBox1.SetFocus;
    Exit;
  end;

  InputDir := ExtractFilePath(Application.ExeName) + 'src\';
  OutputDir := ExtractFilePath(Application.ExeName) + 'dst\';

  //出力フォルダが存在しない場合は作成
  if not DirectoryExists(OutputDir) then
  begin
    ForceDirectories(OutputDir);
  end;

  ExtractPDFs(InputDir, OutputDir, StrToInt(ComboBox1.Text));
end;

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  TempPDFs: TStringList;
  Command, TempPDF, ExtractedPDF, LogFile: string;
  strMsg: string;
  PDFtkPath: string;

  //コマンド実行関数(プロセス完了待ち)
  function ExecuteCommand(const Command: string): Boolean;
  var
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    CmdLine: array[0..MAX_PATH] of Char;
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    StrPCopy(CmdLine, Command);
    Result := CreateProcess(nil, CmdLine, nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo);
    if Result then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  end;

begin

  //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
  //PDFtkPath := '"C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe"';

  //pdftk.exe の PATH は、システム環境変数の PATH で設定する
  PDFtkPath := 'pdftk';

  //エラーがあった場合はLogファイルにエラー内容を出力する
  LogFile := IncludeTrailingPathDelimiter(OutputDir) + 'log.txt';

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) +
            SearchRec.Name, PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
          end;

        until FindNext(SearchRec) <> 0;
      finally
        FindClose(SearchRec);
      end;
    end;

    if TempPDFs.Count > 0 then
    begin
      ExtractedPDF := IncludeTrailingPathDelimiter(OutputDir) + 'filelist.txt';
      TempPDFs.SaveToFile(ExtractedPDF); // ファイルリストを保存
    end;

    //Information
    strMsg := '続けて結合も実行しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      Button2Click(Button1);
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='抽出ページをマージする場合は結合ボタンをクリックしてください';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;

  finally
    TempPDFs.Free;
  end;
end;

3.PDFファイルを結合

ページを抽出後、そのまま結合させることも当然考えたが、処理の確実性を最優先して、別々の手続きに分けて記述することにした。コードは次の通り。

  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);
    procedure MergePDFs;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils;

procedure TForm1.Button2Click(Sender: TObject);
var
  strMsg: string;
begin
  try
    MergePDFs;
    strMsg:='PDFの結合が完了しました!';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
  except
    on E: Exception do
    begin
      strMsg:='エラー: ' + E.Message;
      Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
    end;
  end;
end;

procedure TForm1.MergePDFs;
var
  //ShellExecuteを使用
  //InputDir, OutputFile, Command: string;

  //CreateProcessを使用
  InputDir, OutputFile, Command, CmdLine: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  strMsg: string;
begin

  //ShellExecuteを使用
  {
  InputDir := ExtractFilePath(Application.ExeName)+'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';
  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;
  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('cmd /c pdftk "%s*.pdf" cat output "%s"', [InputDir, OutputFile]);
  //ShellExecuteでpdftkを実行
  ShellExecute(0, 'open', 'cmd.exe', PChar(Command), nil, SW_HIDE);
  }

  //CreateProcessを使用
  InputDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';

  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;

  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('pdftk "%s" cat output "%s"', [InputDir + '*.pdf', OutputFile]);

  //コマンドラインを `cmd.exe /c` でラップ
  CmdLine := Format('cmd.exe /c %s', [Command]);

  // `CreateProcess` の設定
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil, PChar(CmdLine), nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
  begin
    //プロセスが完了するのを待つ
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    //ハンドルを閉じる
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end else begin
    strMsg:='PDFの結合に失敗しました。pdftkが正しくインストールされているか確認してください。';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
  end;

end;

4.進捗状況も表示

進捗状況も表示できるようにした。プログラムコードは「5.まとめ」の最後に掲載。
(Formに StatusBar と ProgressBar を1つずつ追加)

【実行時の画面】

ProgressBar は、StatusBar に埋め込んで表示する。

5.まとめ

テスト用にファイル名が半角数字「001~100」の100個のPDFファイルを作成して実行。半角数字のファイル名であれば、エラーなく実行できることを確認。
ただし、My環境では、ファイル名に「全角・半角・英数字・記号」が混在しているとエラーになりました。このエラーの発生原因の詳細が判明しましたら、後日追記します。

追記(20250211)

上記エラーの発生原因について調査した結果、PDFtk に渡す PATH に「半角スペース」が混じっているとエラーが発生することが判明。そこで、エラーの発生を防止するため、次の対策1・2を行った。

【対策1】

PDFtk に渡す PATH の文字列をダブルクオートで囲んでから渡すように修正。

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"'+IncludeTrailingPathDelimiter(InputDir)+SearchRec.Name+'"',
          PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
            //省略
          end;

【対策2】

対策1を行った後もエラーが発生。PDFtk に渡す PATH をダブルクオートで囲んでもエラーの発生を防止することはできないようだ。そこで、「長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できるのでは・・・?」と考え、PATH を短縮形式(8.3形式) に変換してから PDFtk に渡すように修正。

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  //略

  //指定フォルダ内にあるPDFファイルの数を取得
  function GetPDFFileCount(const FolderPath: string): Integer;
  var
    Files: TArray<string>;
  begin
    //略
  end;

  function GetShortPath(const LongPath: string): string;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    if GetShortPathNameW(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
      Result := ShortPath
    else
      Result := LongPath; // 失敗時はそのまま
  end;

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  function Is8dot3NameAvailable(const Path: string): Boolean;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    FillChar(ShortPath, SizeOf(ShortPath), 0);
    if GetShortPathNameW(PChar(Path), ShortPath, MAX_PATH) > 0 then
      Result := StrComp(ShortPath, PChar(Path)) <> 0  // 短縮名が取得できたか
    else
      Result := False;
  end;

  //Cドライブの 8.3 名を有効に設定
  procedure Enable8dot3Name(DriveLetter: Char);
  var
    Command: string;
  begin
    //fsutil コマンドで 8.3 名を有効化
    Command := Format('fsutil 8dot3name set %s: 0', [DriveLetter]);
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:=Format('%s: ドライブの 8.3 名を有効にしました。', [DriveLetter]);
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //システム全体の 8.3 名を有効化
  procedure Enable8dot3NameForAllDrives;
  var
    Command: string;
  begin
    //fsutil コマンドでシステム全体の 8.3 名を有効化
    Command := 'fsutil behavior set disable8dot3 0';
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:='すべてのドライブで 8.3 名を有効にしました。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

begin

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  if Is8dot3NameAvailable('C:\Program Files') then
  begin
    if CheckBox1.Checked then
    begin
      strMsg:='8.3 名は有効です';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end else begin
    strMsg:='Windowsでは、長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できます。'+
      '現在、8.3 名(短縮名)は無効です。有効化しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      strMsg:='システム全体で有効化しますか?'+#13#10+#13#10+
        '「いいえ」を選択した場合、Cドライブのみ有効化されます。';
      if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
      begin
        Enable8dot3NameForAllDrives;
        //[はい]が選ばれた時
        strMsg:='8.3 名(短縮名)をシステム全体で有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        //[いいえ]が選ばれた時
        Enable8dot3Name('C');
        strMsg:='Cドライブで、8.3 名(短縮名)を有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='長いファイルパスや特殊文字を含むパスは使用できません。'+
        '注意してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //略

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          //さらに短縮形式(8.3形式) に変換して渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"'+GetShortPath(IncludeTrailingPathDelimiter(InputDir)+SearchRec.Name)+'"',
          PageNum, TempPDF, LogFile]);

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);
            //省略
          end;

ただし、GetShortPathNameW は、ローカルファイルシステムの NTFS/FAT32 に保存されているファイルの短縮名を取得する API であり、UNC パスのような ネットワーク共有上のファイルには対応していない。そこで exe がローカルな環境で実行されていない場合は、Form の表示終了時にユーザーに警告してプログラムを終了するように修正。

Winapi.Shlwapi を uses することで、他の手続きで使用していた StrToInt 関数でエラーが発生。こちらはSystem.SysUtils.StrToInt のように参照先を明示してエラーを回避。

  private
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils,
  Winapi.Shlwapi;

  //Shlwapiはexeの起動PATHの確認に使用
  //ShlwapiにもStrToInt関数があるので StrToInt関数は
  //System.SysUtils.StrToInt のように明示的に使用する

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  function IsUNCPath(const Path: string): Boolean;
  begin
    Result := PathIsUNC(PChar(Path));
  end;

  procedure CheckExePath;
  var
    ExePath: string;
  begin
    ExePath := ExtractFilePath(Application.ExeName);
    if IsUNCPath(ExePath) then
    begin
      strMsg:='EXE はネットワーク上の UNC パスで実行されています!'+#13#10+
        'プログラムが安定動作しない可能性があります。'+#13#10+
        'ローカル環境で実行してください。'+#13#10+
        '安全のため、プログラムを終了します。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      Close;
    end;
  end;
begin
  inherited;
  if Visible then
  begin
    Update;
    //実行PATHをチェック
    CheckExePath;
  end;
end;


GUI も修正。


上記対策を行った結果、(My環境では)半角スペースを含む PATH を PDFtk に渡してもエラーが発生することなく、すべてのファイルから指定ページを抽出・結合することができることを確認。

【プログラムコード】

作成の経過が後から見てわかるよう、古いコードをコメント化して残してあるなど、あちこちに冗長な部分があります。あくまでも参考まで。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    Label_01: TLabel;
    Label_02: TLabel;
    Label_04: TLabel;
    ComboBox1: TComboBox;
    Label_03: TLabel;
    Button3: TButton;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure ExtractPDFs(const InputDir, OutputDir: string; PageNum: Integer);
    procedure MergePDFs;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;
  public
  end;

var
  Form1: TForm1;

implementation

uses
  Winapi.ShellAPI,
  System.IOUtils,
  Winapi.Shlwapi;

  //Shlwapiはexeの起動PATHの確認に使用
  //ShlwapiにもStrToInt関数があるので StrToInt関数は
  //System.SysUtils.StrToInt のように明示的に使用する

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  InputDir, OutputDir: string;
  strMsg: string;
begin
  if ComboBox1.Text = '' then
  begin
    strMsg := '抽出するページを指定してください';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONSTOP);
    ComboBox1.SetFocus;
    Exit;
  end;

  InputDir := ExtractFilePath(Application.ExeName) + 'src\';
  OutputDir := ExtractFilePath(Application.ExeName) + 'dst\';

  //出力フォルダが存在しない場合は作成
  if not DirectoryExists(OutputDir) then
  begin
    ForceDirectories(OutputDir);
  end;

  ExtractPDFs(InputDir, OutputDir, System.SysUtils.StrToInt(ComboBox1.Text));

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  strMsg: string;
begin
  try
    MergePDFs;
    strMsg:='PDFの結合が完了しました!';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
  except
    on E: Exception do
    begin
      strMsg:='エラー: ' + E.Message;
      Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  function IsUNCPath(const Path: string): Boolean;
  begin
    Result := PathIsUNC(PChar(Path));
  end;

  procedure CheckExePath;
  var
    ExePath: string;
  begin
    ExePath := ExtractFilePath(Application.ExeName);
    if IsUNCPath(ExePath) then
    begin
      strMsg:='EXE はネットワーク上の UNC パスで実行されています!'+#13#10+
        'プログラムが安定動作しない可能性があります。'+#13#10+
        'ローカル環境で実行してください。'+#13#10+
        '安全のため、プログラムを終了します。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      Close;
    end else begin
      //何もしない
      //strMsg:='EXE はローカルディスク上で実行されています。';
      //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //ここにやりたいことを書いていく
    //実行PATHをチェック
    CheckExePath;
  end;
end;

procedure TForm1.ExtractPDFs(const InputDir, OutputDir: string;
  PageNum: Integer);
var
  SearchRec: TSearchRec;
  TempPDFs: TStringList;
  Command, TempPDF, ExtractedPDF, LogFile: string;
  strMsg: string;
  PDFtkPath: string;
  intNum, PDFCount: Integer;

  //指定フォルダ内にあるPDFファイルの数を取得
  function GetPDFFileCount(const FolderPath: string): Integer;
  var
    Files: TArray<string>;
  begin
    //Result := 0;
    if not DirectoryExists(FolderPath) then
      raise Exception.CreateFmt('Directory %s does not exist.', [FolderPath]);

    Files := TDirectory.GetFiles(FolderPath, '*.pdf', TSearchOption.soTopDirectoryOnly);
    Result := Length(Files);
  end;

  // コマンド実行関数(プロセス完了待ち)
  function ExecuteCommand(const Command: string): Boolean;
  var
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    CmdLine: array[0..MAX_PATH] of Char;
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := SW_HIDE;

    //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
    StrPCopy(CmdLine, Command);
    Result := CreateProcess(nil, CmdLine, nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo);
    if Result then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  end;

  function GetShortPath(const LongPath: string): string;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    //if GetShortPathName(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
    if GetShortPathNameW(PChar(LongPath), ShortPath, MAX_PATH) > 0 then
      Result := ShortPath
    else
      Result := LongPath; // 失敗時はそのまま
  end;

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  function Is8dot3NameAvailable(const Path: string): Boolean;
  var
    ShortPath: array[0..MAX_PATH] of Char;
  begin
    FillChar(ShortPath, SizeOf(ShortPath), 0);
    //if GetShortPathName(PChar(Path), ShortPath, MAX_PATH) > 0 then
    if GetShortPathNameW(PChar(Path), ShortPath, MAX_PATH) > 0 then
      Result := StrComp(ShortPath, PChar(Path)) <> 0  // 短縮名が取得できたか
    else
      Result := False;
  end;

  //Cドライブの 8.3 名を有効に設定
  procedure Enable8dot3Name(DriveLetter: Char);
  var
    Command: string;
  begin
    //fsutil コマンドで 8.3 名を有効化
    Command := Format('fsutil 8dot3name set %s: 0', [DriveLetter]);
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:=Format('%s: ドライブの 8.3 名を有効にしました。', [DriveLetter]);
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //システム全体の 8.3 名を有効化
  procedure Enable8dot3NameForAllDrives;
  var
    Command: string;
  begin
    //fsutil コマンドでシステム全体の 8.3 名を有効化
    Command := 'fsutil behavior set disable8dot3 0';
    if ShellExecute(0, 'runas', 'cmd.exe', PChar('/c ' + Command), nil, SW_HIDE) <= 32 then
    begin
      strMsg:='8.3 名の有効化に失敗しました。管理者権限で実行してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end else begin
      strMsg:='すべてのドライブで 8.3 名を有効にしました。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

begin

  //8.3 名(短縮名)が使えるかどうか確認(C:\Program Files でチェック)
  if Is8dot3NameAvailable('C:\Program Files') then
  begin
    if CheckBox1.Checked then
    begin
      strMsg:='8.3 名は有効です';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end else begin
    strMsg:='Windowsでは、長いファイルパスや特殊文字を含むパスを 短縮形式(8.3形式) に変換することで問題を回避できます。'+
      '現在、8.3 名(短縮名)は無効です。有効化しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      strMsg:='システム全体で有効化しますか?'+#13#10+#13#10+
        '「いいえ」を選択した場合、Cドライブのみ有効化されます。';
      if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
      begin
        Enable8dot3NameForAllDrives;
        //[はい]が選ばれた時
        strMsg:='8.3 名(短縮名)をシステム全体で有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        //[いいえ]が選ばれた時
        Enable8dot3Name('C');
        strMsg:='Cドライブで、8.3 名(短縮名)を有効化しました!';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='長いファイルパスや特殊文字を含むパスは使用できません。'+
        '注意してください。';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;
  end;

  //ProgressBar
  ProgressBar1.Visible:=True;
  ProgressBar1.Min:=0;                    //最小値
  ProgressBar1.Position:=0;               //現在の値
  ProgressBar1.Step:=1;                   //増分値

  //カウンタ変数の初期化
  intNum:=0;

  //PDFtkのPATHはシステム環境変数に設定する(文字列で指定しないこと)
  //PDFtkPath := '"C:\Program Files (x86)\PDFtk Server\bin\pdftk.exe"';

  //pdftk.exe の PATH は、システム環境変数の PATH で設定する
  PDFtkPath := 'pdftk';

  //エラーがあった場合はLogファイルにエラー内容を出力する
  LogFile := IncludeTrailingPathDelimiter(OutputDir) + 'log.txt';

  //指定フォルダ内にあるPDFファイルの数を取得
  PDFCount := GetPDFFileCount(InputDir);

  //進捗状況の表示
  StatusBar1.SimpleText:='進捗状況:';
  ProgressBar1.Visible:=True;
  ProgressBar1.Max:=PDFCount;   //最大値

  TempPDFs := TStringList.Create;
  try
    //指定フォルダ内のすべての PDF を検索
    if FindFirst(IncludeTrailingPathDelimiter(InputDir) + '*.pdf', faAnyFile, SearchRec) = 0 then
    begin
      try
        repeat
          TempPDF := IncludeTrailingPathDelimiter(OutputDir) + 'temp_' +
            IntToStr(TempPDFs.Count) + '.pdf';

          //PDFtkをシステム環境変数のPathに正しく指定してある場合
          //PDFファイル名に半角スペースが含まれていると
          //多数のファイルを処理する場合、確実にエラーが発生する
          {
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
            [PDFtkPath, IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name,
            PageNum, TempPDF, LogFile]);
          }

          //PDFtkに渡すPATHをダブルクオートで囲んで渡すように修正
          //さらに短縮形式(8.3形式) に変換して渡すように修正
          Command := Format('cmd.exe /c %s "%s" cat %d output "%s" 2>> "%s"',
          [PDFtkPath, '"' + GetShortPath(IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name) + '"',
          PageNum, TempPDF, LogFile]);

          //ShowMessage('"' + IncludeTrailingPathDelimiter(InputDir) + SearchRec.Name + '"');

          //pdftk を実行して指定ページを抽出
          if ExecuteCommand(Command) then
          begin
            TempPDFs.Add(TempPDF);

            //ProgressBar
            intNum:=intNum+1;  // <- 記述を忘れないこと!
            //値を増やす時
            If ProgressBar1.Position < ProgressBar1.Max Then
            begin
              //目的の値より一つ大きくしてから、目的の値にする
              ProgressBar1.Position:=intNum+1;
              ProgressBar1.Position:=intNum;
            end else begin
              //最大値にする時
              //最大値を1つ増やしてから、元に戻す
              ProgressBar1.Max:=PDFCount+1;
              ProgressBar1.Position:=intNum+1;
              ProgressBar1.Max:=PDFCount;
              ProgressBar1.Position:=intNum;
            end;
            //処理の表示を止めないおまじない
            Application.ProcessMessages;

          end;

        until FindNext(SearchRec) <> 0;
      finally
        FindClose(SearchRec);
      end;
    end;

    //初期化
    ProgressBar1.Position:=0;

    if TempPDFs.Count > 0 then
    begin
      ExtractedPDF := IncludeTrailingPathDelimiter(OutputDir) + 'filelist.txt';
      TempPDFs.SaveToFile(ExtractedPDF); // ファイルリストを保存
    end;

    // Information_YesNo
    strMsg := '続けて結合も実行しますか?';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      //[はい]が選ばれた時
      Button2Click(Button1);
    end else begin
      //[いいえ]が選ばれた時
      strMsg:='抽出ページをマージする場合は結合ボタンをクリックしてください';
      Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    end;

  finally
    TempPDFs.Free;
    //進捗状況の表示
    StatusBar1.SimpleText:='';
    ProgressBar1.Visible:=False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, w:integer;
begin
  //StatusBarの設定
  StatusBar1.SimplePanel:=True;
  //プログレスバーの初期化
  with ProgressBar1 do begin
    Parent  :=StatusBar1;
    Top     :=2;  //表示位置の調整
    w:= StatusBar1.Canvas.TextWidth('進捗状況:');
    Left    :=w;
    //Left    :=100;  //表示位置の調整
    Height  :=StatusBar1.Height-2;
    Width := StatusBar1.Width-20;
    Visible :=False;
  end;

  //抽出するページの選択肢を作成
  for i := 1 to 999 do
  begin
    ComboBox1.Items.Add(IntToStr(i));
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  //Formを画面の中央に表示
  Left:=(Screen.Width-Width) div 2;
  Top:=(Screen.Height-Height) div 2;
end;

procedure TForm1.MergePDFs;
var
  //ShellExecuteを使用
  //InputDir, OutputFile, Command: string;

  //CreateProcessを使用
  InputDir, OutputFile, Command, CmdLine: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  strMsg: string;
begin

  //ShellExecuteを使用
  {
  InputDir := ExtractFilePath(Application.ExeName)+'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';
  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;
  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('cmd /c pdftk "%s*.pdf" cat output "%s"', [InputDir, OutputFile]);
  //ShellExecuteでpdftkを実行
  ShellExecute(0, 'open', 'cmd.exe', PChar(Command), nil, SW_HIDE);
  }

  //CreateProcessを使用
  InputDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'dst\';
  OutputFile := InputDir + 'MergedOutput.pdf';

  //既存のファイルがあれば削除する
  if FileExists(OutputFile) then
  begin
    //削除
    DeleteFile(OutputFile);
  end;

  //pdftkコマンドの構築(すべてのPDFを結合)
  Command := Format('pdftk "%s" cat output "%s"', [InputDir + '*.pdf', OutputFile]);

  //コマンドラインを `cmd.exe /c` でラップ
  CmdLine := Format('cmd.exe /c %s', [Command]);

  // `CreateProcess` の設定
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil, PChar(CmdLine), nil, nil, False, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
  begin
    //プロセスが完了するのを待つ
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    //ハンドルを閉じる
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end else begin
    strMsg:='PDFの結合に失敗しました。pdftkが正しくインストールされているか確認してください。';
    Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
  end;

end;

end.

追記(20250218)

システム環境変数に PDFtk への PATH が正しく設定されているか、どうかを調べる他に、もう一つ、PDFtk がインストールされているか、どうかを確認する方法も調べてみた。

コマンド・プロンプトを起動して、下記のように「pdftk –version」と入力し、Enter キーを押し下げると、PDFtkがインストールされていれば、次のように応答が返る。


このことを確認しておいて、プログラムを書き、実行するとエラーが発生。当初、なぜエラーになる(IsPDFtkInstalled 関数が False を返す)のか、わからなかったが、出力を確認したところ、ようやく原因が判明。出力は次の通り。

出力が「文字化け」している・・・


シェルの出力を UTF-8 として処理するよう、プログラムを修正。

AStream := TStringStream.Create('', TEncoding.UTF8);

で、ここに出力して・・・

AStream.WriteBuffer(ABuffer, ARead);

さらに StringList に入れて「小文字」にして、出力結果に ‘pdftk’ の文字列が含まれているか、どうかを確認。

AOutput := TStringList.Create;
AOutput.Text := AStream.DataString;

(略)

if Pos('pdftk', LowerCase(AOutput.Text)) > 0 then
begin
  Result := True;
end;

期待通りに動作することを、メッセージを表示して確認(確認後、このメッセージ表示部分はコメント化し、実際に実行する際はインストールされていない場合のみ、メッセージを表示する仕様とした)。

全体のコードは、次の通り。

  private
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  strMsg:string;

  //PDFtkのインストールの有無を確認
  function IsPDFtkInstalled: Boolean;
  var
    AStartupInfo: TStartupInfo;
    AProcessInfo: TProcessInformation;
    ASecurityAttributes: TSecurityAttributes;
    ABuffer: array[0..1023] of Byte;
    ARead: Cardinal;
    AStdOutPipeRead, AStdOutPipeWrite: THandle;
    ACommand: String;
    AOutput: TStringList;
    AStream: TStringStream;
  begin
    Result := False;
    AOutput := TStringList.Create;
    AStream := TStringStream.Create('', TEncoding.UTF8);
    try
      FillChar(ASecurityAttributes, SizeOf(ASecurityAttributes), 0);
      ASecurityAttributes.nLength := SizeOf(ASecurityAttributes);
      ASecurityAttributes.bInheritHandle := True;

      CreatePipe(AStdOutPipeRead, AStdOutPipeWrite, @ASecurityAttributes, 0);
      try
        FillChar(AStartupInfo, SizeOf(AStartupInfo), 0);
        AStartupInfo.cb := SizeOf(AStartupInfo);
        AStartupInfo.hStdOutput := AStdOutPipeWrite;
        AStartupInfo.hStdError := AStdOutPipeWrite;
        AStartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        AStartupInfo.wShowWindow := SW_HIDE;

        ACommand := 'pdftk --version';
        if CreateProcess(nil, PChar('cmd.exe /C ' + ACommand), nil, nil, True, CREATE_NO_WINDOW, nil, nil, AStartupInfo, AProcessInfo) then
        try
          CloseHandle(AStdOutPipeWrite);
          while ReadFile(AStdOutPipeRead, ABuffer, SizeOf(ABuffer), ARead, nil) do
          begin
            if ARead = 0 then Break;
            AStream.WriteBuffer(ABuffer, ARead);
          end;
          AOutput.Text := AStream.DataString;
          WaitForSingleObject(AProcessInfo.hProcess, INFINITE);
        finally
          CloseHandle(AProcessInfo.hProcess);
          CloseHandle(AProcessInfo.hThread);
        end;
      finally
        CloseHandle(AStdOutPipeRead);
      end;

      if AOutput.Count > 0 then
      begin
        //確認用
        //strMsg:='PDFtk output: ' + AOutput.Text;
        //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
        if Pos('pdftk', LowerCase(AOutput.Text)) > 0 then
        begin
          Result := True;
        end;
      end else begin
        //No output from PDFtk command.
        strMsg:='PDFtk からの出力がありません。';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end;
    finally
      AOutput.Free;
      AStream.Free;
    end;
  end;

begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //PDFtkのインストールの有無を確認
    try
      if IsPDFtkInstalled then
      begin
        //確認用
        //strMsg:='PDFtk はインストールされています。';
        //Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
      end else begin
        strMsg:='PDFtk はインストールされていません。'+#13#10+#13#10+
          'https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/'+#13#10+
          '上記Webサイトからダウンロード&インストールしてください。'+#13#10+#13#10+
          'プログラムを終了します。';
        Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
        Close;
      end;
    except
      on E: Exception do begin
        strMsg:='エラー: ' + E.Message;
        Application.MessageBox(PChar(strMsg), PChar('エラー'), MB_ICONERROR);
      end;
    end;
  end;

end;


【注意のお願い】

追記(20250218)の「PDFtk のインストールを確認するプログラムコード」は、上記の「全体のプログラムコード」には含まれておりません。ご注意願います。

6.お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容(プログラムを含む)利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。