vorhandene PDF verleinern, Optionen Ghostscript gesucht

[haentschman]

Hallöle...

Ich habe eine Miniklasse daraus gemacht... Bitteschön.

Delphi-Quellcode:

unit uGhostscript;

interface

uses
  Winapi.Windows,
  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;
  end;

implementation

{ TGhostscript }

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

destructor TSEAMGhostscript.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.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.