unit MainForm;

{$I ..\..\..\Lib\PDFlibDefines.inc}

interface

uses
{$IFDEF XE2+}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.ComCtrls, Vcl.Buttons, Vcl.FileCtrl, System.Math, System.IOUtils,
  Winapi.ShellAPI, System.StrUtils,
{$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, FileCtrl, Math,
  ShellAPI, StrUtils,
{$ENDIF}
  PDFlibrary;

type
  TForm1 = class(TForm)
    btnBrowsePDF: TButton;
    edtPDFFile: TEdit;
    lblPDFFile: TLabel;
    lstFonts: TListBox;
    btnExtractFonts: TButton;
    btnBrowseOutputDir: TButton;
    edtOutputDir: TEdit;
    lblOutputDir: TLabel;
    dlgOpenPDF: TOpenDialog;
    StatusBar1: TStatusBar;
    procedure btnBrowsePDFClick(Sender: TObject);
    procedure btnBrowseOutputDirClick(Sender: TObject);
    procedure btnExtractFontsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure PopulateFontList;
    function GetFontTypeDescription(FontType: Integer): string;
    function CheckFileAccessibility(const FileName: string): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  edtOutputDir.Text := ExtractFilePath(Application.ExeName) + 'extracted';
{$IFDEF XE2+}
  if not TDirectory.Exists(edtOutputDir.Text) then
    TDirectory.CreateDirectory(edtOutputDir.Text);
{$ELSE}
  if not DirectoryExists(edtOutputDir.Text) then
    ForceDirectories(edtOutputDir.Text);
{$ENDIF}
end;

function TForm1.GetFontTypeDescription(FontType: Integer): string;
begin
  case FontType of
    0:
      Result := 'No Font';
    1:
      Result := 'Unknown Font';
    2:
      Result := 'Standard';
    3:
      Result := 'TrueType';
    4:
      Result := 'Embedded TrueType';
    5:
      Result := 'Packaged';
    6:
      Result := 'Type1';
    7:
      Result := 'Subsetted';
    8:
      Result := 'Type3';
    9:
      Result := 'Type1 CID';
    10:
      Result := 'TrueType CID';
    11:
      Result := 'CJK';
  end;
end;

function TForm1.CheckFileAccessibility(const FileName: string): Boolean;
var
  FileHandle: THandle;
  ErrorMsg: string;
begin
  Result := False;

  // Check if file exists
  if not FileExists(FileName) then
  begin
    ErrorMsg := 'File not found: ' + FileName;
    MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
    Exit;
  end;

  // Try to open the file for reading
  try
    FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

    if FileHandle = INVALID_HANDLE_VALUE then
    begin
      ErrorMsg := Format('Cannot access file: %s. Error code: %d', [FileName, GetLastError]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      Exit;
    end;

    CloseHandle(FileHandle);
    Result := True;
  except
    on E: Exception do
    begin
      ErrorMsg := Format('Exception while accessing file: %s. Error: %s', [FileName, E.Message]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      Exit;
    end;
  end;
end;

procedure TForm1.btnBrowsePDFClick(Sender: TObject);
begin
  dlgOpenPDF.Filter := 'PDF Files (*.pdf)|*.pdf';
  if dlgOpenPDF.Execute then
  begin
    edtPDFFile.Text := dlgOpenPDF.FileName;
    StatusBar1.SimpleText := 'Selected file: ' + ExtractFileName(edtPDFFile.Text);

    // Check if file is accessible before attempting to load it
    if CheckFileAccessibility(edtPDFFile.Text) then
      PopulateFontList;
  end;
end;

procedure TForm1.btnBrowseOutputDirClick(Sender: TObject);
var
  Dir: string;
begin
  Dir := edtOutputDir.Text;
{$IFDEF XE2+}
  if SelectDirectory('Select Output Directory', '', Dir, [sdNewFolder, sdShowShares, sdNewUI]) then
{$ELSE}
  if SelectDirectory('Select Output Directory', '', Dir) then
{$ENDIF}
  begin
    edtOutputDir.Text := Dir;
{$IFDEF XE2+}
    if not TDirectory.Exists(edtOutputDir.Text) then
      TDirectory.CreateDirectory(edtOutputDir.Text);
{$ELSE}
    if not DirectoryExists(edtOutputDir.Text) then
      ForceDirectories(edtOutputDir.Text);
{$ENDIF}
  end;
end;

procedure TForm1.PopulateFontList;
var
  PDF: TPDFlib;
  I, FontCount, FontType, LoadResult: Integer;
  FontInfo: string;
  IsEmbedded, IsSubsetted: Boolean;
  EmbeddedStr, SubsettedStr, TypeStr: string;
  ErrorMsg: string;
  SelectResult: Integer;
  FontID: Integer;
begin
  lstFonts.Items.Clear;
  StatusBar1.SimpleText := 'Analyzing PDF file...';
  Application.ProcessMessages;

  PDF := TPDFlib.Create;
  try
    // Save the result of LoadFromFile for error reporting
    LoadResult := PDF.LoadFromFile(edtPDFFile.Text, '');

    if LoadResult = 1 then
    begin
      // Find fonts in the document
      PDF.FindFonts;
      FontCount := PDF.FontCount;
      StatusBar1.SimpleText := Format('Found %d fonts in the document', [FontCount]);

      if FontCount = 0 then
      begin
        MessageBox(Handle, 'No fonts found in this PDF document. The document may not have any text content.', 'Information', MB_OK or MB_ICONINFORMATION);
        Exit;
      end;

      // Display font information
      lstFonts.Items.Add(Format('Number of fonts found: %d', [FontCount]));

      // Iterate through all fonts
      for I := 1 to FontCount do
      begin
        // Get font ID first
        FontID := PDF.GetFontID(I);

        if FontID <= 0 then
        begin
          // Add detailed error information
          ErrorMsg := Format('Font #%d: Error getting font ID. Error code: %d', [I, FontID]);
          lstFonts.Items.Add(ErrorMsg);
          StatusBar1.SimpleText := Format('Error getting font ID #%d', [I]);
          Continue;
        end;

        // Use FontID to select the font
        SelectResult := PDF.SelectFont(FontID);

        if SelectResult <> 1 then
        begin
          // Add detailed error information
          ErrorMsg := Format('Font #%d: Error selecting font with ID %d. Error code: %d', [I, FontID, SelectResult]);
          lstFonts.Items.Add(ErrorMsg);
          // Add debug information
          StatusBar1.SimpleText := Format('Error selecting font #%d. Code: %d', [I, SelectResult]);
          Continue;
        end;

        // Get font type before checking embedding
        FontType := PDF.FontType;
        TypeStr := GetFontTypeDescription(FontType);

        // Check if the font is subsetted
        IsSubsetted := PDF.GetFontIsSubsetted = 1;
        if IsSubsetted then
          SubsettedStr := 'Subsetted'
        else
          SubsettedStr := 'Complete';

        // Now check if the font is embedded
        IsEmbedded := PDF.GetFontIsEmbedded = 1;

        if not IsEmbedded then
        begin
          // Font is not embedded
          lstFonts.Items.Add(Format('Font #%d: %s [%s] - %s - Not Embedded - %s - FontID: %d (skipped - not embedded)', 
                                  [I, PDF.FontName, PDF.FontFamily, TypeStr, SubsettedStr, FontID]));
          Continue;
        end;

        // Set embedded string for embedded fonts
        EmbeddedStr := 'Embedded';

        // Check if font is TrueType (Type 3) or Embedded TrueType (Type 4)
        if (FontType <> 3) and (FontType <> 4) then
        begin
          // Font is not a TrueType font, mark as skipped
          lstFonts.Items.Add(Format('Font #%d: %s [%s] - %s - %s - %s - FontID: %d (skipped - not TrueType font)', 
                                  [I, PDF.FontName, PDF.FontFamily, TypeStr, EmbeddedStr, SubsettedStr, FontID]));
          Continue;
        end;

        // Check if font name is empty
        if PDF.FontName = '' then
          lstFonts.Items.Add(Format('Font #%d: Warning - Empty font name', [I]));

        // Build font information display string
        FontInfo := Format('Font #%d: %s [%s] - %s - %s - %s - FontID: %d', 
                          [I, PDF.FontName, PDF.FontFamily, TypeStr, EmbeddedStr, SubsettedStr, FontID]);

        lstFonts.Items.Add(FontInfo);
      end;
    end
    else
    begin
      // Provide more detailed error information about why the file couldn't be loaded
      case LoadResult of
        0:
          ErrorMsg := 'File could not be loaded (general error)';
        -1:
          ErrorMsg := 'File is password protected';
        -2:
          ErrorMsg := 'File is not a valid PDF';
        -3:
          ErrorMsg := 'File is corrupted';
      else
        ErrorMsg := Format('Unknown error (code: %d)', [LoadResult]);
      end;

      ErrorMsg := Format('Could not load PDF file: %s. %s', [edtPDFFile.Text, ErrorMsg]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      StatusBar1.SimpleText := 'Error loading PDF file';
    end;
  except
    on E: Exception do
    begin
      ErrorMsg := Format('Exception while loading PDF: %s. Error: %s', [edtPDFFile.Text, E.Message]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      StatusBar1.SimpleText := 'Error: ' + E.Message;
    end;
  end;
  PDF.Free;
end;

procedure TForm1.btnExtractFontsClick(Sender: TObject);
var
  PDF: TPDFlib;
  I, FontCount, FontType, LoadResult: Integer;
  FontFileName: string;
  SuccessCount: Integer;
  Log: TStringList;
  ErrorMsg: string;
  SelectResult: Integer;
  SaveResult: Integer;
  FontID: Integer;
  IsEmbedded: Boolean;
  EmbeddedStr: string;
  FoundExtractableFont: Boolean;
  TypeStr: string;
  IsSubsetted: Boolean;
  SubsettedStr: string;
begin
  if lstFonts.Items.Count = 0 then
  begin
    MessageBox(Handle, 'Please select a PDF file first.', 'Information', MB_OK or MB_ICONINFORMATION);
    Exit;
  end;

{$IFDEF XE2+}
  if not TDirectory.Exists(edtOutputDir.Text) then
    TDirectory.CreateDirectory(edtOutputDir.Text);
{$ELSE}
  if not DirectoryExists(edtOutputDir.Text) then
    ForceDirectories(edtOutputDir.Text);
{$ENDIF}
  SuccessCount := 0;

  Log := TStringList.Create;
  Log.Add('Font Extraction Log');
  Log.Add('=================');
  Log.Add('File: ' + edtPDFFile.Text);
  Log.Add('Date: ' + DateTimeToStr(Now));
  Log.Add('Extracting embedded fonts');
  Log.Add('');

  PDF := TPDFlib.Create;
  try
    // Check file accessibility first
    if not CheckFileAccessibility(edtPDFFile.Text) then
    begin
      Log.Add('ERROR: Could not access file: ' + edtPDFFile.Text);
      Log.SaveToFile(edtOutputDir.Text + '\extraction_log.txt');
      Log.Free;
      Exit;
    end;

    // Load the PDF file
    LoadResult := PDF.LoadFromFile(edtPDFFile.Text, '');

    if LoadResult = 1 then
    begin
      // Find fonts in the document
      PDF.FindFonts;
      FontCount := PDF.FontCount;
      Log.Add(Format('Found %d fonts in the document', [FontCount]));

      // Add a blank line to separate logs of different fonts
      Log.Add('');  
      
      // Check for extractable embedded TrueType fonts
      FoundExtractableFont := False;
      
      // Iterate through all fonts
      for I := 1 to FontCount do
      begin
        // Get font ID
        FontID := PDF.GetFontID(I);

        if FontID <= 0 then
        begin
          Log.Add(Format('Font #%d: Failed to get FontID. Error code: %d', [I, FontID]));
          Continue;
        end;

        // Select the font using the ID
        SelectResult := PDF.SelectFont(FontID);

        if SelectResult <> 1 then
        begin
          Log.Add(Format('Font #%d: Error selecting font with ID %d. Error code: %d', [I, FontID, SelectResult]));
          Continue;
        end;

        // Get font information right after selecting it
        FontType := PDF.FontType;
        TypeStr := GetFontTypeDescription(FontType);
        IsEmbedded := PDF.GetFontIsEmbedded = 1;

        // Create embedded status string
        if IsEmbedded then
          EmbeddedStr := 'Embedded'
        else
          EmbeddedStr := 'Not Embedded';
        
        // Get subsetting status
        IsSubsetted := PDF.GetFontIsSubsetted = 1;
        if IsSubsetted then
          SubsettedStr := 'Subsetted'
        else
          SubsettedStr := 'Complete';

        Log.Add(Format('Font #%d: ID=%d, Type=%d (%s), Name=%s, %s, %s', 
              [I, FontID, FontType, TypeStr, PDF.FontName, EmbeddedStr, SubsettedStr]));

        // First, check whether the font is embedded
        if IsEmbedded then
        begin
          // Set embedded string
          EmbeddedStr := 'Embedded';
          
          // Check if it's TrueType (FontType=3) or Embedded TrueType (FontType=4) and embedded
          if (FontType = 3) or (FontType = 4) then
          begin
            // Only extract embedded TrueType fonts
            FoundExtractableFont := True;
            // Create filename
            if (PDF.FontName <> '') then
            begin
              // Clean up font name for valid filename
              FontFileName := StringReplace(PDF.FontName, '/', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '\', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, ':', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '*', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '?', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '<', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '>', '_', [rfReplaceAll]);
              FontFileName := StringReplace(FontFileName, '|', '_', [rfReplaceAll]);
              FontFileName := edtOutputDir.Text + '\' + FontFileName + '.ttf';
            end
            else
              FontFileName := edtOutputDir.Text + '\Font_' + IntToStr(I) + '.ttf';

            // IMPORTANT: Save font file immediately after SelectFont while the font is still selected
            Log.Add(Format('Attempting to save font to %s', [FontFileName]));
            SaveResult := PDF.SaveFontToFile(FontFileName);

            if SaveResult = 1 then
            begin
              Inc(SuccessCount);
              Log.Add(Format('SUCCESS: Saved to %s', [ExtractFileName(FontFileName)]));
              StatusBar1.SimpleText := Format('Extracted font #%d', [I]);
              Application.ProcessMessages;
            end
            else
            begin
              // Try with OTF extension as fallback
              FontFileName := ChangeFileExt(FontFileName, '.otf');
              Log.Add(Format('Retrying with OTF format: %s', [FontFileName]));
              SaveResult := PDF.SaveFontToFile(FontFileName);

              if SaveResult = 1 then
              begin
                Inc(SuccessCount);
                Log.Add(Format('SUCCESS: Saved to %s', [ExtractFileName(FontFileName)]));
                StatusBar1.SimpleText := Format('Extracted font #%d', [I]);
                Application.ProcessMessages;
              end
              else
              begin
                Log.Add(Format('ERROR: Failed to save font. Error code: %d', [SaveResult]));
              end;
            end;
          end
          else
          begin
            Log.Add(Format('Skipped: Font #%d is not TrueType or Embedded TrueType (Type=%s)', 
                          [I, TypeStr]));
          end;
        end
        else
        begin
          Log.Add(Format('Skipped: Font #%d is not embedded (Type=%s)', 
                        [I, TypeStr]));
        end;
        
        // Add a blank line to separate logs of different fonts
        Log.Add('');
      end;

      // Output final results
      if SuccessCount > 0 then
      begin
        Log.Add(Format('Successfully extracted %d fonts out of %d total', [SuccessCount, FontCount]));
        StatusBar1.SimpleText := Format('Extracted %d font(s) of %d total', [SuccessCount, FontCount]);

        // Save log
        Log.SaveToFile(edtOutputDir.Text + '\extraction_success.txt');

        // Show success message
        MessageBox(Handle, PChar(Format('Successfully extracted %d font(s) out of %d total. See log for details.', [SuccessCount, FontCount])), 'Success',
          MB_OK or MB_ICONINFORMATION);

        // Ask whether to open the output directory
        if MessageBox(Handle, 'Open output directory?', 'Question', MB_YESNO or MB_ICONQUESTION) = IDYES then
          ShellExecute(Handle, 'open', PChar(edtOutputDir.Text), nil, nil, SW_SHOW);
      end
      else
      begin
        if FoundExtractableFont then
        begin
          Log.Add('ERROR: No fonts could be extracted from this PDF!');
          StatusBar1.SimpleText := 'Error: No fonts could be extracted';

          // Save error log
          Log.SaveToFile(edtOutputDir.Text + '\extraction_error.txt');

          // Show error message
          MessageBox(Handle, 'Could not extract any fonts from this PDF file.', 'Error', MB_OK or MB_ICONERROR);
        end
        else
        begin
          Log.Add('No Embedded TrueType fonts (FontType = 4) found in the PDF document.');
          StatusBar1.SimpleText := 'No Embedded TrueType fonts found';

          // Save log
          Log.SaveToFile(edtOutputDir.Text + '\no_embedded_truetype_fonts.txt');

          // Show information message
          MessageBox(Handle, 'No Embedded TrueType fonts found in the PDF document.', 
                    'Information', MB_OK or MB_ICONINFORMATION);
        end;
      end;
    end
    else
    begin
      // File loading failed
      case LoadResult of
        0:
          ErrorMsg := 'File could not be loaded (general error)';
        -1:
          ErrorMsg := 'File is password protected';
        -2:
          ErrorMsg := 'File is not a valid PDF';
        -3:
          ErrorMsg := 'File is corrupted';
      else
        ErrorMsg := Format('Unknown error (code: %d)', [LoadResult]);
      end;

      ErrorMsg := Format('Could not load PDF file: %s. %s', [edtPDFFile.Text, ErrorMsg]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      StatusBar1.SimpleText := 'Error loading PDF file';
    end;
  except
    on E: Exception do
    begin
      ErrorMsg := Format('Exception while loading PDF: %s. Error: %s', [edtPDFFile.Text, E.Message]);
      MessageBox(Handle, PChar(ErrorMsg), 'Error', MB_OK or MB_ICONERROR);
      StatusBar1.SimpleText := 'Error: ' + E.Message;
    end;
  end;

  PDF.Free;
  Log.Free;
end;

end.
