PDF Merge

[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