Rekursiv Suchen

[GroZ]

Habe mithilfe eines Arbeitskollegens das Programm komplett umgeschrieben:
Bekomme jetzt eine Exception... Hier der Code:

Delphi-Quellcode:

program FRPtoPDF;

uses
  Forms,
  SysUtils,
  Math,
  ShellApi,
  frxClass,
  frxExportPDF,
  FR_Class,
  PsFR_E_Main,
  PsFR_E_PDF,
  Graphics;

{$AppType Console}

function FRPzuPDF(AFRPFile, APDFFile : string): boolean;
var
  frReport : TfrReport;
  PDFExport : TPsfrPDFExport;
begin
  Result := false;
  if not FileExists(AFRPFile) then
    exit;

  if FileExists(APDFFile) then
    if not DeleteFile(APDFFile) then
      exit;

  frReport := TFrReport.Create(NIL);
  PDFExport := TPsfrPDFExport.Create(NIL);

  try
    PDFExport.ShowDialog := false;
    frReport.ShowProgress := false;
    try
      frReport.LoadPreparedReport(AFRPFile);
      frReport.ExportTo(PDFExport, APDFFile);
    except
      exit;
    end;

  finally
    PDFExport.Free;
    frReport.Free;
  end;

  Result := true;
end;


function VerzeichnisMitFRPzuPDF(PfadUndDateimaske: string; SubDirs: boolean): boolean;
var
  X : TSearchRec;
  Pfad: string;
begin
  Result:=false;

  if FindFirst(PfadUndDateimaske, faAnyFile, X) = 0 then
  try
    repeat
      Write(ExtractFilePath(PfadUndDateimaske)+X.Name+' --> '+ChangeFileExt(ExtractFilePath(PfadUndDateimaske)+X.Name,'.pdf')+'...');

      Result:=FRPzuPDF(ExtractFilePath(PfadUndDateimaske)+X.Name,ChangeFileExt(ExtractFilePath(PfadUndDateimaske)+X.Name,'.pdf'));

      if not Result then
      begin
        Writeln('Fehler!');
        break;
      end
      else
        Writeln('OK');
    until FindNext(X) <> 0;
  finally
    FindClose(X);
  end;

  if Result then
  begin
    if SubDirs then
    begin
      Pfad:=ExtractFilePath(PfadUndDateimaske);

      if FindFirst(Pfad+'*.*', faDirectory, X) = 0 then
      try
        repeat
          if (X.Name <> '.') and (X.Name <> '..') and ((X.Attr and faDirectory) <> 0) then
          begin
            Result:=VerzeichnisMitFRPzuPDF(ExtractFilePath(PfadUndDateimaske)+X.Name+'\'+ExtractFileName(PfadUndDateimaske),SubDirs);
            if not Result then
              break;
          end;
        until FindNext(X) <> 0;
      finally
        FindClose(X);
      end;
    end;
  end;
end;

var
  Parameter : string;
  SubDirs: boolean;
begin
  Writeln('FRP to PDF');

  if ParamCount<1 then
    exit;

  Parameter := ParamStr(1);
  if Copy(Parameter,Length(Parameter),1)<>'\' then
    Parameter:=Parameter+'\';

  if ExtractFileName(Parameter)='' then
    Parameter:=Parameter+'*.FRP';

  SubDirs:=(ParamCount>1) and (AnsiUpperCase(ParamStr(2))='/S');  // /S für SubDirectorys

  VerzeichnisMitFRPzuPDF(Parameter,SubDirs);
end.

Im Anhang ist die Exception...