PDF Merge

[haentschman]

...griegst du gleich. Ich hatte gestern Probleme mit "dynamischen" Parametern.
https://www.delphipraxis.net/206950-...usfuellen.html
FParameters[1] := PAnsiChar('-dBATCH ' + '"'+InFile1+ '"'  +' ' + '"'+InFile2+ '"') ; Das ist der Knackpunkt. Die Files gehören ans Ende als separate Parameter!

[himitsu]

@gaisser: Bei dieser ART von DLLs, wo man die "selben" Parameter reingibt, wie für die EXE,
dort muß man oftmals/meistens auch den Param0 mit reingeben (gefüllt oder leer ist oft egal), also den "Programmaufruf" und erst ab Param1 die Parameter, da in der DPP praktisch der "selbe" Code steckt, wie in der EXE.

Delphi-Quellcode:

FParameters[0] := '';
FParameters[1] := ...;

[gaisser]

Super, vielen Dank!
Also ich hab mal die Unit wo funktioniert angehängt!

Delphi-Quellcode:

unit uGhostscript;

interface

uses
  Winapi.Windows, Vcl.dialogs, Generics.Collections,
  System.Classes, System.SysUtils, System.IOUtils;

const
  conDLLName = 'gsdll32.dll';
  conFileNameTempPDF = 'TempPDF.pdf';

type
  TStdIoFunction = function(CallerHandle: Pointer; Buffer: PAnsiChar;
    Length: Integer): Integer stdcall;
  TGsInit = function(I: Pointer; P: Pointer): Integer; stdcall;
  TGsApiInitWithArgs = function(I: Pointer; L: Integer; A: array of PAnsiChar)
    : Integer; stdcall;
  TGsApiExit = function(I: Pointer): Integer; stdcall;
  TGsApiDeleteInstance = function(I: Pointer): Integer; stdcall;

  TOnErrorEvent = procedure(Sender: TObject; MessageText: string) of object;

  TGhostscript = class
  private
    FDLLPath: string;
    FDLLHandle: THandle;
    FGsInit: TGsInit;
    FGsApiInitWithArgs: TGsApiInitWithArgs;
    FGsApiExit: TGsApiExit;
    FGsApiDeleteInstance: TGsApiDeleteInstance;
    FGsInstance: Pointer;
    FParameters: array of PAnsiChar;
    FOnError: TOnErrorEvent;
    function LoadDLL(PathDLL: string): Boolean;
    function IsFileInUse(FileName: string): Boolean;
  public
    constructor Create(PathDLL: string = '');
    destructor Destroy; override;
    property OnError: TOnErrorEvent read FOnError write FOnError;
    function PDFShrink(FileName: string): Boolean;
    function PDFMerge(OutputFile: string; FileList: TStrings): Boolean;
  end;

implementation

{ TGhostscript }

// Initialisation
constructor TGhostscript.Create(PathDLL: string);
begin
  FDLLPath := PathDLL;
  FDLLHandle := 0;
end;

destructor TGhostscript.Destroy;
begin
  if FDLLHandle > 0 then
  begin
    FreeLibrary(FDLLHandle);
  end;
  inherited;
end;

// Work
function TGhostscript.LoadDLL(PathDLL: string): Boolean;
var
  CurrentDLLPath: string;
begin
  if PathDLL = '' then
  begin
    CurrentDLLPath := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))
      + conDLLName;
  end
  else
  begin
    CurrentDLLPath := PathDLL;
  end;
  FDLLHandle := LoadLibrary(PChar(CurrentDLLPath));
  if FDLLHandle > 0 then
  begin
    FGsInit := GetProcAddress(FDLLHandle, 'gsapi_new_instance');
    Result := (FGsInit(@FGsInstance, nil) = 0);
    if Result then
    begin
      FGsApiInitWithArgs := GetProcAddress(FDLLHandle, 'gsapi_init_with_args');
      FGsApiExit := GetProcAddress(FDLLHandle, 'gsapi_exit');
      FGsApiDeleteInstance := GetProcAddress(FDLLHandle,
        'gsapi_delete_instance');
    end
    else
    begin
      FOnError(Self, 'Die Ghostscript Instanz konnte nicht erzeugt werden.');
      Result := False;
    end;
  end
  else
  begin
    FOnError(Self, Format('Die Ghostscript DLL %s wurde nicht geladen.',
      [QuotedStr(CurrentDLLPath)]));
    Result := False;
  end;

end;

function TGhostscript.IsFileInUse(FileName: string): Boolean;
var
  Stream: TFileStream;
begin
  Result := False;
  Stream := nil;
  if not FileExists(FileName) then
    Exit;
  try
    Stream := TFileStream.Create(FileName, fmOpenRead);
    // Alternative: 'or fmShareExclusive'
  except
    Result := True;
  end;
  Stream.Free;
end;

function TGhostscript.PDFMerge(OutputFile: string; FileList: TStrings): Boolean;
var
  ParametersTemp: TList<AnsiString>;
  InitError: Integer;
  procedure CreateMergeFiles;
  var
    I: Integer;
  begin
    ParametersTemp := TList<AnsiString>.Create;
    for I := 0 to FileList.Count - 1 do
    begin
      ParametersTemp.Add(AnsiString(FileList[I])); // <--
      FParameters[I + 8] := PAnsiChar(ParametersTemp[I]); // <--
    end;
  end;

var
  xDLLFile: String;
begin
  xDLLFile := IncludeTrailingBackslash(FDLLPath) + conDLLName;
  if FileExists(xDLLFile) then
    LoadDLL(xDLLFile);
  if FDLLHandle = 0 then
  begin
    if not LoadDLL(xDLLFile) then
    begin
      Result := False;
      Exit;
    end;
  end;
  try
    ParametersTemp := TList<AnsiString>.Create; // <--
    try
      SetLength(FParameters, FileList.Count + 8);

      FParameters[0] := '';
      FParameters[1] := '-dNOPAUSE';
      FParameters[2] := '-dBATCH';
      FParameters[3] := '-Author=ProTRxxx Software GmbH';
      FParameters[4] := '-Creator=ProTRxxx Software GmbH';
      FParameters[5] := '-dPDFSETTINGS=/printer';
      FParameters[6] := '-sDEVICE=pdfwrite';
      FParameters[7] := PAnsiChar(AnsiString('-sOutputFile=' + OutputFile));
      CreateMergeFiles;

      InitError := FGsApiInitWithArgs(FGsInstance, Length(FParameters),
        FParameters);
      Result := (InitError = 0);
      if InitError <> 0 then
      begin
        if Assigned(FOnError) then
        begin
          FOnError(Self, Format('Fehlercode: %d', [InitError]));
        end;
      end;
    finally
      ParametersTemp.Free;
    end;
  finally
    FGsApiExit(FGsInstance);
  end;

  if not Result then
  begin
    if Assigned(FOnError) then
    begin
      FOnError(Self, Format('Fehler beim Erstellen: %s', [OutputFile]));
    end;
  end;
end;

function TGhostscript.PDFShrink(FileName: string): Boolean;
var
  TargetFileName: string;
begin
  if FDLLHandle = 0 then
  begin
    LoadDLL(FDLLPath);
  end;
  try
    TargetFileName := IncludeTrailingPathDelimiter(ExtractFilePath(FileName)) +
      conFileNameTempPDF;
    SetLength(FParameters, 7);
    FParameters[0] := '';
    FParameters[1] := '-dNOPAUSE';
    FParameters[2] := '-dBATCH';
    FParameters[3] := '-dPDFSETTINGS=/ebook';
    FParameters[4] := '-sDEVICE=pdfwrite';
    FParameters[5] := PAnsiChar(AnsiString('-sOutputFile=' + TargetFileName));
    FParameters[6] := PAnsiChar(AnsiString(FileName));

    Result := (FGsApiInitWithArgs(FGsInstance, Length(FParameters),
      FParameters) = 0);

  finally
    FGsApiExit(FGsInstance);
  end;

  if Result then
  begin
    if not IsFileInUse(FileName) then
    begin
      TFile.Delete(FileName);
      RenameFile(TargetFileName, FileName);
    end;
  end
end;

end.

Der Aufruf ist dann :

Delphi-Quellcode:

procedure TForm1.Button3Click(Sender: TObject);
var
  xPDF: TGhostscript;
  xFiles:TStringList;
begin
if not Assigned(xPDF) then
  xPDF := TGhostscript.Create(ExtractFilePath(Application.ExeName));
  xFiles:=TStringList.Create;
  xFiles.Add(JvFilenameEdit1.Text);
  xFiles.Add(JvFilenameEdit2.Text);
  xPDF.PDFMerge(JvFilenameEdit3.Text,xFiles );
  xFiles.Free;
  xPDF.Free;
end;

Danke Euch allen

[haentschman]

...soviel "Diebstahl" ist ein auf den nächsten Delphi Tagen wert...

[gaisser]

Mit Sicherheit
Aber ein Phänomen hab ich noch...
Unter Debug Comp geht es, aber unter Release nicht, an was kann dies liegen? Er bekommt den FDDLPath nicht zugewiesen???

[elmar.faber]

Hallo,

habe gerade versucht, zwei FastReport PDF's mit Ghostscript zu mergen aber
trotz Aufrufs von gsapi_set_arg_encoding(FGsInstance, GS_ARG_ENCODING_UTF8),
wie von HolgerX vorgeschlagen, werden die Umlaute in Hieroglyphen umgewandelt.

Hat jemand eine Idee, wie man das korrigieren kann?

Viele Grüße

[HolgerX]

Hmm..

Zitat von elmar.faber:

Hallo,

habe gerade versucht, zwei FastReport PDF's mit Ghostscript zu mergen aber
trotz Aufrufs von gsapi_set_arg_encoding(FGsInstance, GS_ARG_ENCODING_UTF8),
wie von HolgerX vorgeschlagen, werden die Umlaute in Hieroglyphen umgewandelt.

Hasst Du die FileNamen auch vorher in ein UTF8 String konvertiert (bei Verwendung von GS_ARG_ENCODING_UTF8)?

In den Quelltexten von gaisser wird nur nach AnsiString konvertiert und nicht nach UTF8, und dann gehen schon so einige Zeichen verloren...

[elmar.faber]

Ja ich habe überall wo "Ansi" steht UTF8 eingesetzt. Fehler kamen keine...
Aufgeruft habe ich die Funktion an dieser Stelle

Delphi-Quellcode:

...
    FGsInit := GetProcAddress(FDLLHandle, 'gsapi_new_instance');
    Result := (FGsInit(@FGsInstance, nil) = 0);
    if Result then
    begin
      Fgsapi_set_arg_encoding := GetProcAddress(FDLLHandle, 'gsapi_set_arg_encoding');
      Fgsapi_set_arg_encoding(FGsInstance, GS_ARG_ENCODING_UTF8);
...

[HolgerX]

Hmm...

Zitat von elmar.faber:

Ja ich habe überall wo "Ansi" steht UTF8 eingesetzt. Fehler kamen keine...
Aufgeruft habe ich die Funktion an dieser Stelle

Delphi-Quellcode:

...
    FGsInit := GetProcAddress(FDLLHandle, 'gsapi_new_instance');
    Result := (FGsInit(@FGsInstance, nil) = 0);
    if Result then
    begin
      Fgsapi_set_arg_encoding := GetProcAddress(FDLLHandle, 'gsapi_set_arg_encoding');
      Fgsapi_set_arg_encoding(FGsInstance, GS_ARG_ENCODING_UTF8);
...

Die Reihenfolge ist bei mir:

gsapi_new_instance
gsapi_set_arg_encoding
gsapi_init_with_args
gsapi_exit

Bei den Argumenten (gsapi_init_with_args) muss der erste Eintrag ein '' sein, da dieser von der GS-APi ignoriert wird (https://www.ghostscript.com/doc/current/API.htm#init).

Bei den anderen Argumenten, welche Strings als Wert enhalten musst du deinen Delphistring mit UTF8Encode nach UTF umcodieren!

Einfach nur aus 'AnsiString' ein 'UTF8String' zu machen, wird wohl nichts bringen...

Sprich z.B. (Src von gaisser):

Delphi-Quellcode:

      SetLength(FParameters, 8);

      FParameters[0] := '';
      FParameters[1] := '-dNOPAUSE';
      FParameters[2] := '-dBATCH';
      FParameters[3] := '-Author=ProTRxxx Software GmbH';
      FParameters[4] := '-Creator=ProTRxxx Software GmbH';
      FParameters[5] := '-dPDFSETTINGS=/printer';
      FParameters[6] := '-sDEVICE=pdfwrite';
      FParameters[7] := PAnsiChar(AnsiString('-sOutputFile=' + UTF8Encode(OutputFile)));

[elmar.faber]

Hallo,

vielen Dank für dein Hilfe aber ich kriege es nicht hin, habe jetzt viel herumexperimentiert
und versucht mit UTF8Encode die Strings um zu kodieren aber ich bekomme immer das gleiche
Resultat. Keine Ahnung was ich jetzt noch versuchen kann...