PDF Dateien, Seitenzahlen ermitteln.

[Branco Wassmuth]

Falls das noch jemanden interessiert:
Ich habe mir vor einer Weile mal eine Funktion geschrieben,
mit der man ohne jegliche Zusatzkomponenten die Anzahl der
Seiten einer PDF-Datei ermitteln kann. Nutze ich jetzt seit
Jahren ohne Probleme. Falls es jemand braucht:

Delphi-Quellcode:

// --> Seitenzahl mit Hilfe der Verweise in der PDF-Struktur (Root -> Pages -> Count) ermitteln:
function GetPdfPageCount(pDateiMitPfad: string): integer;
var
   position, AnzVersuche: integer;
   puffer, pufferTemp, obj, gen: string;
   PosRichtig: boolean;
   DateiGroesse: LongInt;

   function IsNumber(pStr: string): boolean;
   var
      i, code: integer;
   begin
      val(pStr, i, code);
      if code <> 0 then result := False else result := True;
   end;

   procedure GetObjGen(pPuffer: string; pStartPos: integer; NurObj: boolean);
   var
      z: integer;
      KzFuellen: byte; // --> 1 = Variable "obj" füllen; 2 = Variable "gen" füllen
   begin
      KzFuellen := 1;
      obj := '';
      gen := '';

      // --> Werte für "obj" und "gen" ermitteln:
      for z := pStartPos to (pStartPos + 50) do
      begin
         if KzFuellen = 2 then
         begin
            if IsNumber(pPuffer[z]) then gen := gen + pPuffer[z] else break;
         end;

         if KzFuellen = 1 then
         begin
            if IsNumber(pPuffer[z]) then obj := obj + pPuffer[z] else KzFuellen := 2;
            if (KzFuellen = 2) and NurObj then break;
         end;
      end;
   end;
begin
   result := -5;

   try
      screen.cursor := crHourglass;

      // --> Datei einlesen:
      with TFileStream.Create(pDateiMitPfad, fmOpenRead) do
      try
         SetLength(puffer, Size);
         Read(puffer[1], Size);
         DateiGroesse := Size;
      finally
         Free;
      end;

      // --> "Root"-Eintrag suchen, z.B. "/Root 58 0" (58 = obj, 0 = gen):
      position := pos('/ROOT', AnsiUpperCase(puffer));
      if position = 0 then exit;

      // --> "Root"-Eintrag lesen:
      GetObjGen(puffer, position + 6, False); // --> Suche beginnen nach Leerzeichen hinter "Root"
      if (obj = '') or (gen = '') then exit;

      // --> Abschnitt mit "Pages"-Eintrag suchen:
      //     Da ein Eintrag mehrfach gefunden werden kann (bei der Suche nach "1 0 OBJ" wird z.B. auch die Stelle
      //     "11 0 OBJ" gefunden, usw.), ist die Suche auf max. 100000 Versuche begrenzt.
      PosRichtig := False;
      AnzVersuche := 0;
      pufferTemp := puffer;
      repeat
         inc(AnzVersuche);
         position := pos(obj + ' ' + gen + ' OBJ', AnsiUpperCase(pufferTemp));
         if position = 0 then exit;
         if (position <> 0) and (IsNumber(pufferTemp[position - 1]) = False) then PosRichtig := True;
         // --> Bereits durchsuchten Bereich am Anfang abschneiden
         pufferTemp := System.Copy(pufferTemp, position + 8, DateiGroesse);    
      until PosRichtig or (AnzVersuche = 100000);
      if PosRichtig = False then exit;

      // --> "Pages"-Eintrag suchen (erster Eintrag im verbliebenen pufferTemp-Bereich):
      position := pos('/PAGES', AnsiUpperCase(pufferTemp));
      if position = 0 then exit;

      // --> "Pages"-Eintrag lesen:
      GetObjGen(pufferTemp, position + 7, False);
      if (obj = '') or (gen = '') then exit;

      // --> Abschnitt mit "Count"-Eintrag suchen:
      PosRichtig := False;
      AnzVersuche := 0;
      pufferTemp := puffer;
      repeat
         inc(AnzVersuche);
         position := pos(obj + ' ' + gen + ' OBJ', AnsiUpperCase(pufferTemp));
         if position = 0 then exit;
         if (position <> 0) and (IsNumber(pufferTemp[position - 1]) = False) then PosRichtig := True;
         pufferTemp := System.Copy(pufferTemp, position + 8, DateiGroesse);
      until PosRichtig or (AnzVersuche = 100000);
      if PosRichtig = False then exit;

      // --> "Count"-Eintrag suchen:
      position := pos('/COUNT', AnsiUpperCase(pufferTemp));
      if position = 0 then exit;

      // --> "Count"-Eintrag lesen:
      GetObjGen(pufferTemp, position + 7, True);
      if obj = '' then exit;

      screen.cursor := crDefault;
      result := StrToInt(obj);
   except
      // --> Hier keine Fehlermeldung ausgeben (result = -5)
   end;
end;