Delphi: Open a PDF (Sumatra, Foxit and Adobe) file programmatically at a named destination in the PDF

StackOverflow https://stackoverflow.com/questions/21237373

  •  30-09-2022
  •  | 
  •  

質問

I'm the main developer of an open source project (http://nbcgib.uesc.br/lec/software/editores/tinn-r/en).

Now the user guide of the project is in PDF (make under LaTeX).

I'm trying to making a procedure to open the User guide programmatically at a named destination/section in the PDF.

As I do not know the default PDF viewer of the users, I'm developing a procedure to support the major: Sumatra, Foxit and Adobe.

The procedure is working fine for Sumatra, but not for Foxit and Adobe.

Below the code:

function GetAssociation(const DocFileName: string): string;
var
  FileClass: string;
  Reg: TRegistry;

begin
  Result:= '';
  Reg:= TRegistry.Create(KEY_EXECUTE);
  Reg.RootKey:= HKEY_CLASSES_ROOT;
  FileClass:= '';
  if Reg.OpenKeyReadOnly(ExtractFileExt(DocFileName)) then
  begin
    FileClass:= Reg.ReadString('');
    Reg.CloseKey;
  end;
  if FileClass <> '' then begin
    if Reg.OpenKeyReadOnly(FileClass +
                           '\Shell\Open\Command') then
    begin
      Result:= Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.Free;
end;

procedure TfrmTinnMain.OpenUserGuidePDF(sWhere: string);
var
  sFile,
   sViewerDefault,
   sParameter: string;

begin
  sViewerDefault:= GetAssociation('.pdf');

  if pos('Sumatra',                     // Sumatra: OK
         sViewerDefault) > 0 then
    sParameter:= '-reuse-instance ' +
                 '-named-dest ' +
                 sWhere
  else if pos('Foxit',                  // Foxit: opens the file, but not at the named destination
              sViewerDefault) > 0 then
    sParameter:= '/A ' +
                 'page=100'
  else if pos('Adobe',                  // Adobe: opens the file, but not at the named destination
              sViewerDefault) > 0 then begin
    sWhere:= StringReplace(sWhere,
                           '"',
                           '',
                           [rfReplaceAll]);

    sParameter:= '/A ' +
                 '"' +
                 'nameddest=' +
                 sWhere +
                 '"';
  end
  else
    sParameter:= '';

  sFile:= sPathTinnR +
          '\doc\User guide.pdf';
  try
    // Open PDF viewer
    ShellExecute(0,
                 'open',
                 Pchar(sFile),
                 Pchar(sParameter),
                 nil,
                 sw_shownormal);

  except
    MessageDlg('PDF viewer is not accessible!',
               mtInformation,
               [mbOk],
               0);
  end;
end;

procedure TfrmTinnMain.menHelUserGuideClick(Sender: TObject);
begin
  OpenUserGuidePDF('"Contents"');
end;
役に立ちましたか?

解決

I would like to thanks all observations and suggestions!

I found it more practical to distribute (jointly with Tinn-R) the portable version of SumatraPDF. If Sumatra is the system default it will be used. Otherwise, the portable version will be used.

Below the computational solution:

procedure TfrmTinnMain.OpenUserGuidePDF(sWhere: string);
var
  sFile,
   sViewerDefault,
   sPathSumatra,
   sParameter: string;

begin
  sFile:= sPathTinnR +
          '\doc\User guide.pdf';

  sParameter:= '-reuse-instance ' +
               '-named-dest ' +
               sWhere;
  try
    sViewerDefault:= GetAssociation('.pdf');

    if pos('Sumatra',
           sViewerDefault) > 0 then
      // Open default PDF viewer
      ShellExecute(0,
                   'open',
                   Pchar(sFile),
                   Pchar(sParameter),
                   nil,
                   sw_shownormal)
    else begin
      sPathSumatra:= sPathTinnR +
                     '\sumatra\SumatraPDF.exe';

      // Open SumatraPDF viewer
      OpenCmdLine(sPathSumatra +
                  ' "' +
                  sFile +
                  '"' +
                  sParameter,
                  sw_shownormal);
    end;
  except
    MessageDlg('PDF viewer is not accessible!',
               mtInformation,
               [mbOk],
               0);
  end;
end;

The call:

procedure TfrmTinnMain.menHelUserGuideClick(Sender: TObject);
begin
  OpenUserGuidePDF('"Contents"');
end;

Necessary functions and procedures:

{ Execute a complete shell command line without waiting. }
function OpenCmdLine(const CmdLine: string;
                     wWindowState: Word): Boolean;
var
  sUInfo: TStartupInfo;
  pInfo : TProcessInformation;

begin
  { Enclose filename in quotes to take care of long filenames with spaces. }
  FillChar(sUInfo,
           SizeOf(sUInfo),
           #0);
  with SUInfo do
  begin
    cb         := SizeOf(sUInfo);
    dwFlags    := STARTF_USESHOWWINDOW;
    wShowWindow:= wWindowState;
  end;
  Result:= CreateProcess(nil,
                         PChar(CmdLine),
                         nil,
                         nil,
                         False,
                         CREATE_NEW_CONSOLE or
                         NORMAL_PRIORITY_CLASS,
                         nil,
                         nil {PChar(ExtractFilePath(sFileName))},
                         sUInfo,
                         pInfo);
end;

function GetAssociation(const DocFileName: string): string;
var
  FileClass: string;
  Reg: TRegistry;

begin
  Result:= '';
  Reg:= TRegistry.Create(KEY_EXECUTE);
  Reg.RootKey:= HKEY_CLASSES_ROOT;
  FileClass:= '';
  if Reg.OpenKeyReadOnly(ExtractFileExt(DocFileName)) then
  begin
    FileClass:= Reg.ReadString('');
    Reg.CloseKey;
  end;
  if FileClass <> '' then begin
    if Reg.OpenKeyReadOnly(FileClass +
                           '\Shell\Open\Command') then
    begin
      Result:= Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.Free;
end;

Any suggestion will be welcome!

All the best,

J.C.Faria

他のヒント

Let Windows decide what the default viewer for that file type is:

ShellExecute(0, 'open', Filename, nil, nil, SW_SHOW);
ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top