PDF Merge

[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???