Minimal PDF parser to extract text of first page

PdfParser.pas

unit PdfParser;

interface

uses SysUtils, Classes;

type
  TPdfDocument=class;//forward

  TPdfDataBlockType=(dbtDictionary,dbtArray,dbtSingleValue);

  TPdfDataBlock=class(TObject)
  private
    FType:TPdfDataBlockType;
    FItems:array of record
      Name,Value:AnsiString;
      Block:TPDfDataBlock;
    end;
    FItemsCount,FItemsIndex:integer;
    FStreamPos,FBlockSize:cardinal;
    function GetIndex(const Name:AnsiString):integer;
    function GetItem(const Name:AnsiString):AnsiString; overload;
    function GetBlock(const Name:AnsiString):TPdfDataBlock;
    procedure AddItem(const Name, Value: AnsiString; Block: TPdfDataBlock);
    function Build(const Indent:AnsiString): AnsiString;
    procedure SetItem(const Name, Value: AnsiString);
    procedure SetBlock(const Name: AnsiString; const Value: TPdfDataBlock);
  public
    constructor Create;
    destructor Destroy; override;
    function Parse(const data:AnsiString;start,dataLength:cardinal):cardinal;
    function Exists(const Name:AnsiString):boolean;
    function GetInt(const Name:AnsiString):integer;
    function NextItem(var i:integer;var Value:AnsiString;AllowBlocks:boolean):boolean;
    property Item[const Name:AnsiString]:AnsiString read GetItem write SetItem; default;
    property Block[const Name:AnsiString]:TPdfDataBlock read GetBlock write SetBlock;
    property StreamPos:cardinal read FStreamPos;
    property BlockType: TPdfDataBlockType read FType;
    property BlockSize:cardinal read FBlockSize;
  end;

  TPdfXRefQuery=function(Sender:TPdfDocument;OldIndex:cardinal):cardinal of object;
  TPdfXRefHandler=function(Sender:TPdfDocument;OldIndex:cardinal):cardinal of object;
  TPdfResourceHandler=procedure(const ResType,Name:string;Nr:integer) of object;
  TPdfOutputString=procedure(const x:AnsiString) of object;

  TPdfDocument=class(TObject)
  private
    FData:TStream;
    FXref:array of record
      Pos,Rev:cardinal;
    end;
    FXrefLength:cardinal;
    FRootNr,FScratch:AnsiString;
    function ParseBlock(pos: cardinal):TPdfDataBlock;
    function ParseXRef(pos: cardinal): TPdfDataBlock;
    function ParseRef(const ref: AnsiString): cardinal;
    function NextFromArray(const src: TPdfDataBlock; var i: integer; var doc: TPdfDataBlock): boolean;
    function PageScript(const blk: TPdfDataBlock): AnsiString;
    function GetEntry(pos: cardinal): AnsiString;
    function GetIntR(blk: TPdfDataBlock; const Name:AnsiString):integer;//warning: could overwrite FScratch!
  public
    constructor Create(const FilePath:string;FromMem:boolean);
    destructor Destroy; override;
    function GetFirstPageText:AnsiString;
  end;

  EPdfDocumentParseError=class(Exception);

implementation

uses Windows, Graphics, JPEG, ZLib;

procedure PdfFail(const x:AnsiString);
begin
  raise EPdfDocumentParseError.Create('PDF '+string(x));
end;

{ TPdfDocument }

const
  ScratchSize=$10000;

constructor TPdfDocument.Create(const FilePath: string; FromMem: boolean);
var
  i,j,l:cardinal;
  b:boolean;
  trailer:TPdfDataBlock;
begin
  inherited Create;
  if FromMem then
   begin
    FData:=TMemoryStream.Create;
    (FData as TMemoryStream).LoadFromFile(FilePath);
   end
  else
    FData:=TFileStream.Create(FilePath,fmOpenRead or fmShareDenyWrite);
  FXrefLength:=0;
  SetLength(FScratch,ScratchSize);//thread var? local var?

  //check header
  FData.Position:=0;
  l:=FData.Read(FScratch[1],ScratchSize);
  if (l<8) or (Copy(FScratch,1,5)<>'%PDF-') then PdfFail('header not found');
  if l=ScratchSize then
   begin
    FData.Seek(-ScratchSize,soFromEnd);
    l:=FData.Read(FScratch[1],ScratchSize);
   end;
  j:=l-4;
  i:=5;
  while (i<>0) and (j>=1) and (Copy(FScratch,j,5)<>'%%EOF') do
   begin
    inc(i);
    dec(j);
   end;
  if (i=0) or (j<1) then PdfFail('footer not found');
  dec(j);
  while (j>0) and (FScratch[j] in [#13,#10]) do dec(j);
  i:=j;
  while (i>0) and not(FScratch[i] in [#13,#10]) do dec(i);
  if (i<10) or not((Copy(FScratch,i-9,9)='startxref') or (Copy(FScratch,i-10,9)='startxref')) then
    PdfFail('footer incorrect');
  i:=StrToInt(string(Copy(FScratch,i+1,j-i)));

  //read xref
  trailer:=ParseXRef(i);
  FRootNr:=trailer['Root'];
  try
    //other xref's
    b:=trailer.Exists('Prev');//XRefStm?
    while b do
     begin
      i:=trailer.GetInt('Prev');
      FreeAndNil(trailer);
      trailer:=ParseXRef(i);
      b:=trailer.Exists('Prev');
     end;
  finally
    trailer.Free;
  end;

  //FPDFVersion:=?
end;

destructor TPdfDocument.Destroy;
var
  i:integer;
begin
  FData.Free;
  inherited;
end;

function TPdfDocument.ParseXRef(pos: cardinal): TPdfDataBlock;
var
  i,j,l,x1,x2:cardinal;
begin
  FData.Position:=pos;
  //assert Length(FScratch)=ScratchSize
  l:=FData.Read(FScratch[1],ScratchSize);
  if (l<8) or (Copy(FScratch,1,4)<>'xref') then PdfFail('xref incorrect');
  i:=5;
  while (i<l) and (FScratch[i] in [#13,#10]) do inc(i);
  while Copy(FScratch,i,7)<>'trailer' do
   begin
    j:=i;
    while (j<l) and (FScratch[j]<>' ') do inc(j);
    x1:=StrToInt(string(Copy(FScratch,i,j-i)));
    inc(j);
    i:=j;
    while (j<l) and not(FScratch[j] in [#13,#10]) do inc(j);
    x2:=StrToInt(string(Copy(FScratch,i,j-i)));
    if x1+x2>FXrefLength then
     begin
      i:=FXrefLength;
      FXrefLength:=x1+x2;
      SetLength(FXref,FXrefLength);
      while i<FXrefLength do
       begin
        FXref[i].Pos:=0;
        FXref[i].Rev:=$FFFF;//65535
        inc(i);
       end;
     end;
    while (j<l) and (FScratch[j] in [#13,#10]) do inc(j);
    i:=j;
    while x2>0 do
     begin
      if l-i<$400 then //assert trailer fit in this margin
       begin
        j:=l-i+1;
        Move(FScratch[i],FScratch[1],j);
        l:=cardinal(FData.Read(FScratch[j+1],ScratchSize-j))+j;
        i:=1;
       end;
      if FScratch[i+17]='n' then
       begin
        FXref[x1].Pos:=StrToInt(string(Copy(FScratch,i,10)));
        FXref[x1].Rev:=StrToInt(string(Copy(FScratch,i+11,5)));
       end;
      //else?
      dec(x2);
      inc(x1);
      inc(i,20);
     end;
   end;
  inc(i,7);
  while (i<l) and (FScratch[i] in [#13,#10]) do inc(i);
  //Assert trailer data fits within margin
  Result:=TPdfDataBlock.Create;
  Result.Parse(FScratch,i,l);
end;

function TPdfDocument.ParseBlock(pos: cardinal):TPdfDataBlock;
var
  i,j,l:cardinal;
begin
  FData.Position:=pos;
  //assert Length(FScratch)=ScratchSize
  //Assert block fits within
  l:=FData.Read(FScratch[1],ScratchSize);
  //check starts with x1,' ',x2,' obj'
  i:=1;
  while (i<l) and (FScratch[i] in ['0'..'9']) do inc(i);//check FLastParseRef?
  if FScratch[i]=' ' then inc(i);
  while (i<l) and (FScratch[i] in ['0'..'9']) do inc(i);//check 0?
  if FScratch[i]=' ' then inc(i);
  if (i>l-3) or (FScratch[i]<>'o') or (FScratch[i+1]<>'b') or (FScratch[i+2]<>'j') then
    PdfFail('invalid object declaration')
  else
    inc(i,3);

  Result:=TPdfDataBlock.Create;
  j:=Result.Parse(FScratch,i,l);

  //check stream
  while (j<l) and (FScratch[j]<=' ') do inc(j);
  if Copy(FScratch,j,6)='stream' then
   begin
    inc(j,6);
    if (j<l) and (FScratch[j]=#13) then inc(j);
    if (j<l) and (FScratch[j]=#10) then inc(j);
    Result.FStreamPos:=pos+j-1;//assert always read of dataLength before Parse call
    i:=cardinal(GetIntR(Result,'Length'));
    FData.Position:=Result.FStreamPos+i;
    inc(i,j-1);
    l:=FData.Read(FScratch[1],ScratchSize);
    j:=1;
    if (j<l) and (FScratch[j]=#13) then inc(j);
    if (j<l) and (FScratch[j]=#10) then inc(j);
    if Copy(FScratch,j,9)<>'endstream' then PdfFail('endstream not found') else inc(j,9);
    if (j<l) and (FScratch[j]=#13) then inc(j);
    if (j<l) and (FScratch[j]=#10) then inc(j);
    if Copy(FScratch,j,6)<>'endobj' then PdfFail('endobj not found') else inc(j,6);
    Result.FBlockSize:=i+j;
   end
  else
   begin
    if Copy(FScratch,j,6)<>'endobj' then PdfFail('endobj not found') else inc(j,6);
    Result.FBlockSize:=j;
   end;
end;

function TPdfDocument.ParseRef(const ref:AnsiString):cardinal;
var
  i,j,l,x1,x2:cardinal;
begin
  l:=Length(ref);
  if (l=0) or (ref[l]<>'R') then PdfFail('value is not a reference');

  i:=1;
  while (i<=l) and (ref[i]>' ') do inc(i);
  x1:=StrToInt(string(Copy(ref,1,i-1)));
  while (i<=l) and (ref[i]<=' ') do inc(i);
  j:=i;
  while (j<=l) and (ref[j]>' ') do inc(j);
  x2:=StrToInt(string(Copy(ref,i,j-i)));

  if x1>FXrefLength then PdfFail('reference past xref length');
  if FXref[x1].Rev<>x2 then PdfFail('reference revision mismatch');
  if FXref[x1].Rev=$FFFF then PdfFail('reference to unused entry');

  Result:=FXref[x1].Pos;
end;

function TPdfDocument.NextFromArray(const src: TPdfDataBlock;var i:integer;var doc:TPdfDataBlock):boolean;
var
  r:AnsiString;
begin
  //assert src.BlockType=dbtArray;
  Result:=src.NextItem(i,r,false);
  if Result then doc:=ParseBlock(ParseRef(r));
end;

function TPdfDocument.PageScript(const blk: TPdfDataBlock): AnsiString;
var
  d:AnsiString;
  i,j,k,l:integer;
  p,q:TPdfDataBlock;
  ptr:PAnsiChar;
begin
  i:=0;
  k:=0;
  Result:='';
  p:=nil;//default
  q:=blk.Block['Contents'];
  if q=nil then
    p:=ParseBlock(ParseRef(blk['Contents']))
  else
    if q.BlockType<>dbtArray then PdfFail('PageScript: Contents not a value or array');
  while (p<>nil) or ((q<>nil) and NextFromArray(q,i,p)) do
    try
      j:=p.StreamPos;
      if j=0 then PdfFail('PageScript: page content without stream');
      l:=GetIntR(p,'Length');
      d:=p['Filter'];
      FData.Position:=j;
      if d='' then
       begin
        SetLength(Result,k+l);
        j:=FData.Read(Result[k+1],l);
        if j<>l then PdfFail('PageScript: error reading content');
        inc(k,l);
       end
      else
      if d='/FlateDecode' then
       begin
        SetLength(d,l);
        j:=FData.Read(d[1],l);
        if j<>l then PdfFail('PageScript: error reading content');
        DecompressBuf(@d[1],l,0,pointer(ptr),integer(j));
        SetLength(Result,k+j);
        Move(ptr^,Result[k+1],j);
        FreeMem(ptr);
        inc(k,j);
       end
      else
        PdfFail('PageScript: Unknown filter "'+d+'"');
    finally
      FreeAndNil(p);//p.Free;p:=nil;
    end;
end;

function TPdfDocument.GetEntry(pos:cardinal):AnsiString;
var
  i,j,l:integer;
begin
  FData.Position:=pos;
  //assert Length(FScratch)=ScratchSize
  //Assert block fits within
  l:=FData.Read(FScratch[1],ScratchSize);
  //check starts with x1,' ',x2,' obj',eol?
  i:=1;
  while (i<l) and (FScratch[i]>=' ') do inc(i);
  while (i<l) and (FScratch[i]<' ') do inc(i);

  j:=i;
  while (j+6<=l) and (Copy(FScratch,j,6)<>'endobj') do inc(j);
  dec(j);
  while (j>i) and (FScratch[j]<=' ') do dec(j);

  Result:=Copy(FScratch,i,j-i+1);
end;

function TPdfDocument.GetIntR(blk: TPdfDataBlock; const Name: AnsiString): integer;
var
  v:AnsiString;
  l:integer;
begin
  v:=blk[Name];
  l:=Length(v);
  if (l<>0) and (v[1]<>'/') and (v[l]='R') then
   begin
    v:=GetEntry(ParseRef(v));
    blk[Name]:=v;
   end;
  if not(TryStrToInt(v,Result)) then
    PdfFail('"'+Name+'" is not a valid integer value "'+v+'"');
end;

function TPdfDocument.GetFirstPageText:AnsiString;
var
  d:AnsiString;
  info,k,p:TPdfDataBlock;
  i,j,l:integer;
begin
  info:=ParseBlock(ParseRef(FRootNr));
  try
    if info['Type']<>'/Catalog' then PdfFail('Catalog expected: "'+info['Type']+'"');
    d:=info['Pages'];
  finally
    info.Free;
  end;
  info:=ParseBlock(ParseRef(d));
  try
    p:=nil;//default
    k:=info;
    while (k<>nil) do
     begin
      if k['Type']<>'/Pages' then PdfFail('Pages expected: "'+k['Type']+'"');
      k:=k.Block['Kids'];//array
      if (k=nil) or (k.BlockType<>dbtArray) then PdfFail('Pages list is not an array');
      if not NextFromArray(k,i,p) then
        PdfFail('Failed to get first page from list');
      d:=p['Type'];
      if d='/Pages' then
        k:=p
      else
        if d='/Page' then
          k:=nil//end loop
        else
          PdfFail('page(s) entry expected "'+d+'"');
     end;
    if p=nil then PdfFail('Failed to get first page');
    d:=PageScript(p);
  finally
    info.Free;
  end;

  Result:='';
  l:=Length(d);
  i:=1;
  while (i<=l) do
   begin
    while (i<=l) and (d[i]<>'(') do inc(i);
    if i<=l then
     begin
      inc(i);
      j:=i;
      while (j<=l) and (d[j]<>')') do
       begin
        if (d[j]='\') then inc(j);
        inc(j);
       end;
      if j-i>0 then Result:=Result+Copy(d,i,j-i)+#13#10;
      i:=j+1;
     end;
   end;
end;

{ TPdfDataBlock }

constructor TPdfDataBlock.Create;
begin
  inherited Create;
  FItemsCount:=0;
  FItemsIndex:=0;
  FStreamPos:=0;
  FType:=dbtDictionary;//default, see parse
end;

destructor TPdfDataBlock.Destroy;
var
  i:integer;
begin
  for i:=0 to FItemsIndex-1 do FreeAndNil(FItems[i].Block);
  inherited;
end;

function TPdfDataBlock.GetIndex(const Name: AnsiString): integer;
begin
  //TODO: better algo?
  Result:=0;
  while (Result<FItemsIndex) and (FItems[Result].Name<>Name) do inc(Result);
end;

function TPdfDataBlock.GetInt(const Name: AnsiString): integer;
var
  i:integer;
begin
  i:=GetIndex(Name);
  if i=FItemsIndex then PdfFail('"'+Name+'" integer not found') else
    if not(TryStrToInt(FItems[i].Value,Result)) then
      PdfFail('"'+Name+'" is not a valid integer value "'+FItems[i].Value+'"');
end;

function TPdfDataBlock.GetBlock(const Name: AnsiString): TPdfDataBlock;
var
  i:integer;
begin
  i:=GetIndex(Name);
  if i<FItemsIndex then Result:=FItems[i].Block else Result:=nil; //PdfFail?
end;

procedure TPdfDataBlock.SetBlock(const Name: AnsiString;
  const Value: TPdfDataBlock);
var
  i:integer;
begin
  i:=GetIndex(Name);
  if i<FItemsIndex then FItems[i].Block:=Value else AddItem(Name,'',Value); //PdfFail?
end;

function TPdfDataBlock.GetItem(const Name: AnsiString): AnsiString;
var
  i:integer;
begin
  i:=GetIndex(Name);
  if i<FItemsIndex then Result:=FItems[i].Value else Result:=''; //PdfFail?
end;

procedure TPdfDataBlock.SetItem(const Name, Value: AnsiString);
var
  i:integer;
begin
  i:=GetIndex(Name);
  if i<FItemsIndex then FItems[i].Value:=Value else AddItem(Name,Value,nil); //PdfFail?
end;

function TPdfDataBlock.Exists(const Name: AnsiString): boolean;
var
  i:integer;
begin
  i:=GetIndex(Name);
  Result:=i<FItemsIndex;
end;

function TPdfDataBlock.Parse(const data: AnsiString; start, dataLength: cardinal): cardinal;
var
  i,j,k:cardinal;
  done:boolean;
  block:TPdfDataBlock;
  key:AnsiString;
begin
  //assert FItemsIndex=0 (only call Parse once)
  //TODO: comments? '%'
  //is it a block, array or something else?
  i:=start;
  while (i<dataLength) and (data[i]<=' ') do inc(i);
  if (i+2>dataLength) or (data[i]<>'<') or (data[i+1]<>'<') then
   begin
    //not a block
    if data[i]='[' then
     begin
      FType:=dbtArray;
      inc(i);
      while (i<dataLength) and (data[i]<=' ') do inc(i);
     end
    else
     begin
      FType:=dbtSingleValue;
      SetLength(FItems,1);
      FItemsCount:=1;
      FItemsIndex:=0;
     end;
   end
  else
   begin
    FType:=dbtDictionary;
    inc(i,2);
    while (i<dataLength) and (data[i]<=' ') do inc(i);
   end;
  //now parse the field(s)
  done:=false;
  key:='';
  while (i<dataLength) and not(done) do
   begin
    //item key
    case FType of
      dbtDictionary:
       begin
        if (i+2<dataLength) and (data[i]='>') and (data[i+1]='>') then
         begin
          done:=true;
          inc(i,2);
         end
        else
         begin
          if data[i]<>'/' then PdfFail('invalid block key');
          inc(i);
          j:=i;
          while (j<dataLength) and not(data[j] in [#0..' ','(',')','<','>','[',']','{','}','/','%']) do inc(j);
          key:=Copy(data,i,j-i);
          while (j<dataLength) and (data[j]<=' ') do inc(j);
          i:=j;
         end;
       end;
      dbtSingleValue:done:=true;
    end;
    //item value
    if not(done) or (FType=dbtSingleValue) then
     begin
      j:=i;
      if i>=dataLength then PdfFail('object interrupted');
      case data[i] of
        '['://array, block
         begin
          block:=TPdfDataBlock.Create;
          j:=block.Parse(data,i,dataLength);
          AddItem(key,'',block);
         end;
        '/'://key
         begin
          inc(j);
          while (j<dataLength) and not(data[j] in [#0..' ','(',')','<','>','[',']','{','}','/','%']) do inc(j);
          AddItem(key,Copy(data,i,j-i),nil);
         end;
        '<'://hex or block
          if (i+1<dataLength) and (data[i+1]='<') then
           begin
            //block
            block:=TPdfDataBlock.Create;
            j:=block.Parse(data,i,dataLength);
            AddItem(key,'',block);
           end
          else
           begin
            //hex
            while (j<dataLength) and (data[j]<>'>') do inc(j); //not(data[j] in ['0'..'9','A'..'F','a'..'f'])?
            inc(j);
            AddItem(key,Copy(data,i,j-i),nil);
           end;
        '('://literal
         begin
          while (j<dataLength) and (data[j]<>')') do
           begin
            if data[j]='\' then inc(j);
            inc(j);
           end;
          inc(j);
          AddItem(key,Copy(data,i,j-i),nil);
         end;
        '-','0'..'9'://number(s)?
         begin
          if (data[j]='-') then inc(j);
          while (j<dataLength) and (data[j] in ['0'..'9','.']) do inc(j);
          //is it a reference?
          k:=j;
          while (k<dataLength) and (data[k]<=' ') do inc(k);
          while (k<dataLength) and (data[k] in ['0'..'9']) do inc(k);
          if (k+1<dataLength) and (data[k]=' ') and (data[k+1]='R') then
           begin
            //it's a reference
            inc(k,2);
            AddItem(key,Copy(data,i,k-i),nil);
            j:=k;
           end
          else
           begin
            //it's only a number
            AddItem(key,Copy(data,i,j-i),nil);
           end;
         end;
        ']':
         begin
          done:=true;
          inc(j);
         end;
        '>':
          if (i+1<dataLength) and (data[i+1]='>') then
           begin
            PdfFail('unexpected key only');//?
            done:=true;
            inc(j,2);
           end
          else PDFFail('unexpected greater than');
        else
         begin
          //some other literal name (true,false...)
          while (j<dataLength) and not(data[j] in [#0..' ','(',')','<','>','[',']','{','}','/','%']) do inc(j);
          AddItem(key,Copy(data,i,j-i),nil);
         end;
      end;
      i:=j;
      while (i<dataLength) and (data[i]<=' ') do inc(i);
     end;
   end;
  if i>=dataLength then PdfFail('object interrupted');
  Result:=i;
  //if dbtDictionary then check 'endobj'?
end;

function TPdfDataBlock.Build(const indent:AnsiString): AnsiString;
var
  i:integer;
begin
  case FType of
    dbtDictionary:
     begin
      Result:='<<';
      for i:=0 to FItemsIndex-1 do if (FItems[i].Value<>'') or (FItems[i].Block<>nil) then
       begin
        Result:=Result+#10+indent+'/'+FItems[i].Name+' ';
        if FItems[i].Block=nil then
          Result:=Result+FItems[i].Value
        else
          Result:=Result+FItems[i].Block.Build(indent+'  ');
       end;
      Result:=Result+#10+indent+'>>';
     end;
    dbtArray:
     begin
      Result:='[';
      for i:=0 to FItemsIndex-1 do
        if FItems[i].Block=nil then
          Result:=Result+' '+FItems[i].Value
        else
          Result:=Result+#10+indent+FItems[i].Block.Build(indent+'  ')+#10+indent;
      Result:=Result+' ]';
     end;
    dbtSingleValue:Result:=FItems[0].Value;
  end;
end;

procedure TPdfDataBlock.AddItem(const Name,Value:AnsiString;Block:TPdfDataBlock);
begin
  if FItemsIndex=FItemsCount then
   begin
    //grow
    inc(FItemsCount,$100);
    SetLength(FItems,FItemsCount);
   end;
  if FType=dbtArray then
    FItems[FItemsIndex].Name:=IntToStr(FItemsIndex)
  else
    FItems[FItemsIndex].Name:=Name;
  if block=nil then
   begin
    FItems[FItemsIndex].Value:=Value;
    FItems[FItemsIndex].Block:=nil;
   end
  else
   begin
    FItems[FItemsIndex].Value:='';
    FItems[FItemsIndex].Block:=Block;
   end;
  inc(FItemsIndex);
end;

function TPdfDataBlock.NextItem(var i:integer; var Value:AnsiString;AllowBlocks:boolean): boolean;
begin
  //assert FType=dbtArray
  if i<FItemsIndex then
   begin
    Result:=true;
    if not(AllowBlocks) and (FItems[i].Block<>nil) then PdfFail('unexpected embedded block in array');
    //assert FItems[i].Name=IntToStr(i)
    Value:=FItems[i].Value;
    inc(i);
   end
  else
    Result:=false;
end;

end.