add caching to uncompressed object stream data due to slowness of VBA decompression

Author: PerditionC

dist/CombinePDF.xlsm

@@ -19,7 +19,6 @@ Sub TestHeaderAndVersion()
     Debug.Print "[" & pdfDoc.Header & "]"
 End Sub
 
-
 Sub TestProblemPdfs()
     On Error GoTo errHandler
     Const basedir As String = "C:\Users\jeremyd\Downloads\"

src/Tests.bas

@@ -32,6 +32,9 @@ Private m_Pages As pdfValue
 ' cache of loaded/shared objects
 Public objectCache As Dictionary ' of pdfValue key'd by object id
 
+' cache only used when loading embedded objects from stream object streams, caches the stream object
+Private sosCache As Dictionary
+
 ' the full contents of raw PDF document
 Private content() As Byte
 
@@ -129,20 +132,16 @@ Public Property Get Info() As pdfValue
         ' note: we Set m_Info instead of Me.Info as we are retrieving /Info id from trailer's reference object already
 
         ' get reference to /Info object (object itself should not be stored directly in trailer)
+        ' if no /Info key or it refers to null, then returns pdf null value
+        ' (if /Info stored directly as object, not valid, but we will return that anyway)
         Dim infoRefObj As pdfValue: Set infoRefObj = GetInfo(trailer)
-        Dim infoId As Long: infoId = -1
         If infoRefObj.valueType = PDF_ValueType.PDF_Reference Then
-            infoId = CLng(infoRefObj.Value)
+            Set m_Info = getObject(CLng(infoRefObj.Value), CLng(infoRefObj.generation), cacheObject:=False)
         'ElseIf info.valueType = PDF_ValueType.PDF_Object Then
+        'ElseIf info.valueType = PDF_ValueType.PDF_Null Then
+        'Else error, unexpected type
         End If
 
-        If objectCache.Exists(infoId) Then
-            Set m_Info = objectCache.Item(infoId)
-        Else
-            'Set m_Info = GetInfoObject(content, trailer, xrefTable)
-            Set m_Info = getObject(content, xrefTable, infoId)
-            'objectCache.Add m_Info.id, m_Info
-        End If
         Debug.Print BytesToString(m_Info.serialize())
     End If
 
@@ -203,13 +202,8 @@ Public Property Get Meta() As pdfValue
                 Dim pdfRefObj As pdfValue
                 Set pdfRefObj = rootCatalog.asDictionary.Item("/Metadata")
                 ' 1st try loading cached object, if that fails, try loading from raw content()
-                If objectCache.Exists(CLng(pdfRefObj.Value)) Then
-                    Set m_Meta = objectCache.Item(CLng(pdfRefObj.Value))
-                Else
-                    Set m_Meta = getObject(content, xrefTable, pdfRefObj.Value)
-                End If
+                Set m_Meta = getObject(CLng(pdfRefObj.Value), pdfRefObj.generation, cacheObject:=False)
                 Debug.Print BytesToString(m_Meta.serialize())
-                'objectCache.Add m_Meta.id, m_Meta
             Else
                 Debug.Print "No /Metadata object specified in root /Catalog"
             End If
@@ -237,7 +231,7 @@ Public Property Get pages() As pdfValue
             ' obj should now be a reference to our /Pages object
             If obj.valueType = PDF_ValueType.PDF_Reference Then
                 ' retrieve object (not reference) matching given obj reference's (id, generation) pair
-                Set m_Pages = getCachedObject(obj.Value, obj.generation)
+                Set m_Pages = getObject(CLng(obj.Value), obj.generation)
             ElseIf obj.valueType = PDF_ValueType.PDF_Object Then
                 ' ok, weird but whatever
                 Set m_Pages = obj
@@ -257,8 +251,65 @@ End Property
 
 
 ' returns matching object from PDF
-' will first try to find in objectCache, then uses cross reference table to load from content,
+' will first try to find in objectCache, then uses cross reference table to load from content(),
 ' otherwise returns pdf null object
+' Note: unless cacheObject is set to False, if successfully extracted object from content() then will add to object cache
+Public Function getObject(ByVal id As Long, ByVal generation As Long, Optional ByVal cacheObject As Boolean = True) As pdfValue
+    Dim obj As pdfValue
+    ' first try loading from our cache
+    Set obj = getCachedObject(id, generation)
+    ' if it wasn't there then try loading from content()
+    If obj.valueType = PDF_ValueType.PDF_Null Then
+        Set obj = pdfParseAndGetValues.getObject(content, xrefTable, id, sosCache)
+        If obj Is Nothing Then Set obj = New pdfValue
+        
+        ' if successfully loaded, update our object cache
+        If cacheObject And (obj.valueType <> PDF_ValueType.PDF_Null) Then
+            If objectCache.Exists(id) Then
+                ' we need to determine if same generation, presumably not or we would have retrieved it above
+                Dim dict As Dictionary
+                Dim curObj As pdfValue
+                Dim v As Variant
+                Set v = objectCache.Item(id)
+                If TypeName(v) = "pdfValue" Then
+                    Set curObj = objectCache.Item(id)
+                    If curObj.generation <> generation Then
+                        Set dict = New Dictionary
+                        dict.Add curObj.generation, curObj
+                        dict.Add generation, obj
+                        Set objectCache(id) = dict
+                        Set dict = Nothing
+                    Else
+                        Debug.Print "Internal Error! - id & generation the same but not?"
+                        Stop
+                    End If
+                    Set curObj = Nothing
+                ElseIf TypeName(v) = "Dictionary" Then
+                    ' assume may contain multiple generations, key'd by generation
+                    Set dict = v
+                    If dict.Exists(generation) Then
+                        Set dict(generation) = obj
+                    Else
+                        dict.Add generation, obj
+                    End If
+                    Set dict = Nothing
+                Else
+                    Debug.Print "Internal Error!"
+                    Stop
+                End If
+            Else
+                objectCache.Add id, obj
+            End If
+        End If
+    End If
+    
+    Set getObject = obj
+End Function
+
+
+' returns matching object from PDF
+' will first try to find in objectCache, if not found in cache then returns pdf null object
+' Does not attempt to load from raw pdf in content() via cross reference table
 Public Function getCachedObject(ByVal id As Long, ByVal generation As Long) As pdfValue
     Dim v As Variant
     ' return object, but verify matches expected generation
@@ -366,7 +417,7 @@ End Function
 ' will fail if loadPDF has not been called or content() array is not prefilled by other means
 ' True on success, false on any error
 Public Function parsePdf() As Boolean
-    GetObjectsInTree rootCatalog, content, xrefTable, objectCache
+    GetObjectsInTree rootCatalog, content, xrefTable, objectCache, sosCache
 
     ' /Info is in trailer, so won't be loaded as part of rootCatalog,
     ' Note first call to Info actually retreives, so need to: Set Info = GetInfoObject(content, trailer, xrefTable)
@@ -633,6 +684,7 @@ End Sub
 Private Sub Class_Initialize()
     On Error GoTo errHandler
     Set objectCache = New Dictionary
+    Set sosCache = New Dictionary
     Set xrefTable = NewXrefTable()
     Set rootCatalog = New pdfValue
     Set trailer = NewTrailer()
@@ -648,6 +700,7 @@ End Sub
 Private Sub Class_Terminate()
     On Error GoTo errHandler
     Set objectCache = Nothing
+    Set sosCache = Nothing
     Set xrefTable = Nothing
     Set rootCatalog = Nothing
     Set trailer = Nothing

src/inflate_rfc1951.bas

@@ -96,11 +96,9 @@ Function GetValueType(ByRef bytes() As Byte, ByVal offset As Long) As PDF_ValueT
         Case "%"
             GetValueType = PDF_ValueType.PDF_Comment
 
-        Case "e", ">" ', "]"
+        Case "e", ">" '
             tmpStr = GetWord(bytes, offset)
             Select Case LCase(tmpStr)
-'                Case "]"
-'                    GetValueType = PDF_ValueType.PDF_EndOfArray
                 Case ">>"
                     GetValueType = PDF_ValueType.PDF_EndOfDictionary
                 Case "endstream"
@@ -451,8 +449,7 @@ Function GetDictionaryValue(ByRef Value As pdfValue, ByVal name As String) As pd
     If Value.Value.Exists(name) Then
         Set GetDictionaryValue = Value.Value.Item(name)
     Else
-        Set GetDictionaryValue = New pdfValue
-        GetDictionaryValue.valueType = PDF_ValueType.PDF_Null
+        Set GetDictionaryValue = New pdfValue   ' defaults to PDF_ValueType.PDF_Null
     End If
     Exit Function
 errHandler:
@@ -640,6 +637,9 @@ Function ParseXrefTable(ByRef content() As Byte, ByRef offset As Long, ByRef tra
 
         ' we need the uncompressed (un-/Filter'd) data
         Dim rawData() As Byte
+#If True Then
+        rawData = objStream.udata
+#Else
         If objStream.Meta.Exists("/Filter") Then
             ' TODO support all /Filter types
             Dim filter As String
@@ -753,6 +753,7 @@ Function ParseXrefTable(ByRef content() As Byte, ByRef offset As Long, ByRef tra
         Else
             rawData = objStream.data
         End If
+#End If
 
         Dim objOffset As Long
         objOffset = 0
@@ -849,7 +850,10 @@ errHandler:
 End Function
 
 
-Function getObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal Index As Long) As pdfValue
+' extracts/parses pdf object from raw pdf content()
+' due to potential slowness uncompressing in VBA, stream object streams should be cached
+' the sosCache is only used for stream object streams and only if provided
+Function getObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal Index As Long, ByRef sosCache As Dictionary) As pdfValue
     On Error GoTo errHandler
     Dim obj As pdfValue
     If xrefTable.Exists(Index) Then
@@ -862,17 +866,26 @@ Function getObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal
             Dim cntrObjEntry As xrefEntry
             Set cntrObjEntry = xrefTable.Item(entry.embedObjId)
             Dim cntrObj As pdfValue
-            Set cntrObj = getObject(content, xrefTable, entry.embedObjId)
-            Dim dict As Dictionary
-            Set dict = cntrObj.Value.Value.Meta
+            ' try loading containing object (stream object stream) from cache before potentially uncompressing
+            If Not sosCache Is Nothing Then
+                If sosCache.Exists(entry.embedObjId) Then Set cntrObj = sosCache(entry.embedObjId)
+            End If
+            If cntrObj Is Nothing Then  ' not in cache or no cache provided
+                Set cntrObj = getObject(content, xrefTable, entry.embedObjId, sosCache)
+                If Not sosCache Is Nothing Then Set sosCache(entry.embedObjId) = cntrObj    ' add/update cache
+            End If
 
             ' extract our embedded object
-            Dim cbuf() As Byte, buffer() As Byte
-            Dim inOff As Long, outSize As Long, estBufSize As Long
-            cbuf = cntrObj.Value.Value.data
-            inOff = 2
-            If dict.Exists("/DL") Then estBufSize = CLng(dict.Item("/DL").Value) ' only a hint
-            If inflate2(cbuf, buffer, inOff, outSize, estBufSize) Then
+            If cntrObj.Value.valueType <> PDF_ValueType.PDF_Stream Then
+                Debug.Print "Error! expecting stream object stream!"
+                Stop
+                GoTo nullValue
+            End If
+            Dim streamObjectStream As pdfStream
+            Set streamObjectStream = cntrObj.Value.Value
+            Dim buffer() As Byte
+            buffer = streamObjectStream.udata
+            If (UBound(buffer) - LBound(buffer)) > 0 Then
                 ' parse embedded object data
                 ' buffer has N sets of obj id# <whitespace> offset
                 ' immediately followed by objects' data, note: /First
@@ -883,6 +896,8 @@ Function getObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal
                 Dim embOffset As Long
                 Dim i As Long
                 Dim firstOffset As Long
+                Dim dict As Dictionary
+                Set dict = streamObjectStream.Meta
                 If dict.Exists("/First") Then
                     firstOffset = CLng(dict.Item("/First").Value)
                 Else
@@ -927,7 +942,7 @@ Function getObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal
                 obj.valueType = PDF_ValueType.PDF_Object
                 Set obj.Value = GetValue(buffer, embOffset)
             Else
-                Debug.Print "Error inflating embedded object!"
+                Debug.Print "Error reading embedded object!"
                 Stop
             End If
         Else
@@ -956,7 +971,7 @@ Function GetRootObject(ByRef content() As Byte, ByRef trailer As pdfValue, ByRef
     ' get either reference or /Root object itself
     Set root = GetRoot(trailer)
     If root.valueType = PDF_ValueType.PDF_Reference Then
-        Set root = getObject(content, xrefTable, root.Value)
+        Set root = getObject(content, xrefTable, root.Value, Nothing)
     'ElseIf root.valueType = PDF_ValueType.PDF_Object Then
     End If
 
@@ -976,7 +991,7 @@ Function GetInfoObject(ByRef content() As Byte, ByRef trailer As pdfValue, ByRef
     ' get either reference or /Info object itself
     Set Info = GetInfo(trailer)
     If Info.valueType = PDF_ValueType.PDF_Reference Then
-        Set Info = getObject(content, xrefTable, Info.Value)
+        Set Info = getObject(content, xrefTable, Info.Value, Nothing)
     'ElseIf info.valueType = PDF_ValueType.PDF_Object Then
     End If
 
@@ -991,7 +1006,7 @@ End Function
 
 
 ' updates objects Dictionary with all objects under root node, indexed by object id, i.e. loads a chunk of the PDF document
-Sub GetObjectsInTree(ByRef root As pdfValue, ByRef content() As Byte, ByRef xrefTable As Dictionary, ByRef objects As Dictionary)
+Sub GetObjectsInTree(ByRef root As pdfValue, ByRef content() As Byte, ByRef xrefTable As Dictionary, ByRef objects As Dictionary, ByRef sosCache As Dictionary)
     On Error GoTo errHandler
     Dim obj As pdfValue
     Dim v As Variant
@@ -1003,27 +1018,27 @@ Sub GetObjectsInTree(ByRef root As pdfValue, ByRef content() As Byte, ByRef xref
         Case PDF_ValueType.PDF_Array
             For Each v In root.Value
                 Set obj = v
-                GetObjectsInTree obj, content, xrefTable, objects
+                GetObjectsInTree obj, content, xrefTable, objects, sosCache
             Next v
         Case PDF_ValueType.PDF_Dictionary
             For Each v In root.Value.Items
                 Set obj = v
-                GetObjectsInTree obj, content, xrefTable, objects
+                GetObjectsInTree obj, content, xrefTable, objects, sosCache
             Next v
         Case PDF_ValueType.PDF_Object
-            GetObjectsInTree root.Value, content, xrefTable, objects
+            GetObjectsInTree root.Value, content, xrefTable, objects, sosCache
         Case PDF_ValueType.PDF_Reference
             ' we need to load object
             If Not objects.Exists(CLng(root.Value)) Then
-                Set obj = getObject(content, xrefTable, root.Value)
+                Set obj = getObject(content, xrefTable, root.Value, sosCache)
                 objects.Add CLng(root.Value), obj
-                GetObjectsInTree obj, content, xrefTable, objects
+                GetObjectsInTree obj, content, xrefTable, objects, sosCache
             End If
         Case PDF_ValueType.PDF_Stream
             Dim stream As pdfStream
             Set stream = root.Value
-            GetObjectsInTree stream.stream_meta, content, xrefTable, objects
-            GetObjectsInTree stream.stream_data, content, xrefTable, objects
+            GetObjectsInTree stream.stream_meta, content, xrefTable, objects, sosCache
+            GetObjectsInTree stream.stream_data, content, xrefTable, objects, sosCache
         Case PDF_ValueType.PDF_StreamData
             ' Nothing to do
         Case PDF_ValueType.PDF_Trailer