ある朝、職場の同僚から「様式(ページ構成)が同じ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 の設定を変更せずにインストールした場合の設定です)
【重要な注意】
インストールした「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つずつ追加)
【実行時の画面】

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