fix bugs in renumbering, combine back to basic functionality but ready for proper outline support

Author: PerditionC

dist/CombinePDF.xlsm

@@ -392,48 +392,97 @@ End Sub
 
 
 ' updates id of all objects under root pdfValue beginning at baseId
-' Note: use trailer as root to renumber whole document
+' Note: if root is Nothing then will update whole document including caches
 ' Warning: assumes each obj id refers to same obj and objReference instances
-Public Function renumberIds(ByRef root As pdfValue, ByVal baseId As Long, Optional ByRef visited As Dictionary = Nothing) As Long
+Public Function renumberIds(ByVal baseId As Long, Optional ByRef root As pdfValue = Nothing, Optional ByRef visited As Dictionary = Nothing) As Long
     On Error GoTo errHandler
-    If visited Is Nothing Then Set visited = New Dictionary
     Dim v As Variant
     Dim obj As pdfValue
-    ' sanity check
-    If root Is Nothing Then Exit Function
+    Dim fixCache As Boolean
+    
+    ' renumber whole tree?
+    If root Is Nothing Then
+        fixCache = True
+        Set root = trailer
+    End If
+    
+    ' should be Nothing on first call, we use this to avoid recursion and thus renumber already renumbered objs
+    If visited Is Nothing Then
+        Set visited = New Dictionary
+    End If
+    
     ' don't renumber same object more than once
     If root.id <> 0 Then
-        If visited.Exists(root.id) Then
+        If visited.Exists(root) Then
             renumberIds = baseId
             Exit Function
         End If
         ' and actually do the renumbering
         root.id = baseId
         baseId = baseId + 1
-        visited.Add root.id, root.id
+        ' Note: we use actual object and not id here as temp there may be multiple objs with same id
+        ' e.g. obj 1 renumbered to 4, and there is still an object 4 not yet renumbered
+        visited.Add root, root
     End If
     ' update any children
     Select Case root.valueType
         Case PDF_ValueType.PDF_Array
             For Each v In root.value
                 Set obj = v
-                baseId = renumberIds(obj, baseId, visited)
+                baseId = renumberIds(baseId, obj, visited)
             Next v
         Case PDF_ValueType.PDF_Dictionary
             For Each v In root.value.Items
                 Set obj = v
-                baseId = renumberIds(obj, baseId, visited)
+                baseId = renumberIds(baseId, obj, visited)
             Next v
         Case PDF_ValueType.PDF_Reference
             Set obj = getObject(root.value, 0)
-            baseId = renumberIds(obj, baseId, visited)
+            baseId = renumberIds(baseId, obj, visited)
         Case PDF_ValueType.PDF_Trailer, PDF_ValueType.PDF_Object
-            baseId = renumberIds(root.value, baseId, visited)
+            baseId = renumberIds(baseId, root.value, visited)
         Case Else
             ' no nested objects that need id's updated
     End Select
     ' last id used, or same as provided if nothing updated
     renumberIds = baseId
+    
+    ' because we renumbered everything, we need to invalidate or rebuild our cache's
+    ' but only from top level call
+    ' note: because we have renumbered, we also invalidate our content buffer as it refers to old ids
+    If fixCache Then
+        'Set visited = Nothing ' this is ByRef so only set to Nothing if originally Nothing
+        
+        If ByteArraySize(content) >= 0 Then Erase content
+        Dim newDict As Dictionary
+        If Not objectCache Is Nothing Then
+            Set newDict = New Dictionary
+            For Each v In objectCache.Items
+                Set obj = v
+                If obj.id <> 0 Then Set newDict(obj.id) = obj
+            Next v
+            Set objectCache = newDict
+            Set newDict = Nothing
+        End If
+    
+        If Not refCache Is Nothing Then
+            Set newDict = New Dictionary
+            For Each v In refCache.Items
+                Set obj = v
+                With obj
+                    If .id <> 0 Then
+                        Set newDict(.id & "_" & .generation) = obj
+                        Set newDict(.id & " " & .generation & " R") = obj.referenceObj
+                    End If
+                End With
+            Next v
+            Set refCache = newDict
+            Set newDict = Nothing
+        End If
+    
+        Set sosCache = Nothing
+    End If
+    
     Exit Function
 errHandler:
     Debug.Print "Error: " & Err.Description & " (" & Err.Number & ")"
@@ -453,7 +502,7 @@ Public Function getObject(ByVal id As Long, ByVal generation As Long, Optional B
     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 = loadObject(content, xrefTable, id)
+        Set obj = loadObject(id)
         If obj Is Nothing Then Set obj = New pdfValue
 
         ' if successfully loaded, update our object cache
@@ -1325,7 +1374,6 @@ Function GetValue(ByRef bytes() As Byte, ByRef offset As Long, Optional ByRef Me
         Case PDF_ValueType.PDF_Reference, PDF_ValueType.PDF_Object
             Dim words(0 To 2) As String
             words(0) = GetWord(bytes, offset)
-If IsMatch(words(0), "3") Then Stop
             offset = SkipWhiteSpace(bytes, offset)
             words(1) = GetWord(bytes, offset)
             offset = SkipWhiteSpace(bytes, offset)
@@ -1446,19 +1494,33 @@ End Function
 
 
 ' extracts/parses pdf object from raw pdf content()
+' uses xrefTable to determine offset directly or obtain using cross reference stream
 ' 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
 ' the refCache is to ensure only 1 indirect reference object instance is created for each object
 ' this will use provided VBA reference object instance instead of creating a new [different] one
-Function loadObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVal Index As Long) As pdfValue
+' forceReload bypasses refCache and returns a new VBA object instance ***
+' *** changes to this object's id may not effect any other object nor their reference values
+' *** if object previously loaded returns a new instance, otherwise results same as if is False
+' *** possibly useful to duplicate an object to be mutated and added, but use with care
+Function loadObject(ByVal Index As Long, Optional forceReload As Boolean = False) As pdfValue
     On Error GoTo errHandler
     Dim obj As pdfValue
+    
+    ' speed up, ensure single object returned, and avoid issues when objects are removed from current objectCache
+    If (Not forceReload) And (Not refCache Is Nothing) Then
+        If refCache.Exists(Index) Then
+            Set loadObject = refCache(Index)
+            Exit Function
+        End If
+    End If
+    
     If xrefTable.Exists(Index) Then
         Dim entry As xrefEntry
         Set entry = xrefTable.Item(Index)
         If entry.isFree Or ((Not entry.isEmbeded) And (entry.offset <= 0)) Then GoTo NullValue
         Dim offset As Long: offset = entry.offset
-        If offset > UBound(content) Then GoTo NullValue
+        If offset > ByteArraySize(content) Then GoTo NullValue
         If entry.isEmbeded Then
             Dim cntrObjEntry As xrefEntry
             Set cntrObjEntry = xrefTable.Item(entry.embedObjId)
@@ -1468,7 +1530,7 @@ Function loadObject(ByRef content() As Byte, ByRef xrefTable As Dictionary, ByVa
                 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 = loadObject(content, xrefTable, entry.embedObjId)
+                Set cntrObj = loadObject(entry.embedObjId)
                 If Not sosCache Is Nothing Then Set sosCache(entry.embedObjId) = cntrObj    ' add/update cache
             End If
 
@@ -1567,7 +1629,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 = loadObject(content, xrefTable, root.value)
+        Set root = loadObject(root.value)
     'ElseIf root.valueType = PDF_ValueType.PDF_Object Then
     End If
 
@@ -1607,7 +1669,7 @@ Sub GetObjectsInTree(ByRef root As pdfValue, ByRef content() As Byte, ByRef xref
         Case PDF_ValueType.PDF_Reference
             ' we need to load object
             If Not objects.Exists(CLng(root.value)) Then
-                Set obj = loadObject(content, xrefTable, root.value)
+                Set obj = loadObject(root.value)
                 objects.Add CLng(root.value), obj
                 GetObjectsInTree obj, content, xrefTable, objects
             End If

src/pdfLib.xlsm/Class Modules/pdfDocument.cls

@@ -18,9 +18,9 @@ Option Explicit
 Public pdfDoc As pdfDocument
 
 Private Sub cbContinue_Click()
-    pdfDoc.renumberIds pdfDoc.trailer, 100
-    pdfDoc.savePdfAs "renumberd.pdf"
-    Stop
+    'pdfDoc.renumberIds pdfDoc.trailer, 100
+    'pdfDoc.savePdfAs "renumberd.pdf"
+    'Stop
     Me.Hide
     Unload Me
 End Sub

src/pdfLib.xlsm/Forms/ufFileList.frx

@@ -2,8 +2,19 @@ Attribute VB_Name = "Main"
 Option Explicit
 
 
+' simple function lets user pick files to combine
+Public Sub PickAndCombinePdfFiles()
+    Dim files() As String
+    files = PickFiles()
+    Dim ufFileOrder As ufFileList: Set ufFileOrder = New ufFileList
+    ufFileOrder.list = files
+    ufFileOrder.Show
+    files = ufFileOrder.list
+    CombinePDFs files, "combined.pdf"
+End Sub
+
+
 Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
-    'Dim oPages As pdfValue  ' /Type /Pages with /Count # /Kids [ /Page references ...]
     Dim combinedPdfDoc As pdfDocument: Set combinedPdfDoc = New pdfDocument
     ' initialize with some basic structures
     combinedPdfDoc.AddInfo
@@ -17,15 +28,8 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
     Dim outputFileNum As Integer
     outputFileNum = combinedPdfDoc.SavePdfHeader(outFile, offset)
 
-    Dim baseId As Long
-    ' we don't yet know the id's used by our /Root, /Info and top level /Pages objs
-    With combinedPdfDoc
-        .rootCatalog.id = -1
-        .Info.id = -2
-        .pages.id = -3
-    
-        baseId = .nextObjId
-    End With
+    ' get where to start renumbering objs in pdf, we need to skip past our toplevel /Root, /Info, /Pages, & /Outlines
+    Dim baseId As Long: baseId = combinedPdfDoc.nextObjId
 
     Dim ndx As Long
     For ndx = LBound(sourceFiles) To UBound(sourceFiles)
@@ -37,35 +41,28 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
         pdfDoc.loadPdf sourceFiles(ndx)
         pdfDoc.parsePdf
 
-        ' for each additional document we need to update /Pages
-        Dim pages As pdfValue
-        Set pages = pdfDoc.pages()
-        
-        ' since we are about to remove it, we use 1st pdf doc's /Root id for our new top level /Pages (so we have for /Parent references)
-        ' Note: once we add pdfDoc.pages to combinedPdfDoc.pages and save, we can no longer change id of combinedPdfDoc.pages
-        With combinedPdfDoc
-            If .pages.id < 0 Then
-                .pages.id = pdfDoc.rootCatalog.id
-            End If
-        End With
-        
-        ' remove /Root object, we need to copy/merge some optional fields such as /Outline for bookmarks
-        ' and ensure only left with 1 /Root
-        pdfDoc.objectCache.Remove pdfDoc.rootCatalog.id
-        ' also need to remove /Info from cache
-        If pdfDoc.objectCache.Exists(pdfDoc.Info.id) Then
-            pdfDoc.objectCache.Remove pdfDoc.Info.id
-        End If
-        
+        ' adjust obj id's so no conflict with previously stored ones
+        pdfDoc.renumberIds baseId
+            
         ' we inject a new top level /Pages object which we add all the document /Pages to
         ' so we need to add this /Pages to our top level /Pages and add a /Parent indirect reference
         combinedPdfDoc.AddPages pdfDoc.pages
 
+        ' we need to copy/merge some optional fields such as /Outline for bookmarks
         If pdfDoc.rootCatalog.hasKey("/Outlines") Then
             ' hack for now, just copy over
             combinedPdfDoc.rootCatalog.asDictionary().Add "/Outlines", pdfDoc.rootCatalog.asDictionary().Item("/Outlines")
         End If
 
+        ' remove /Root object and ensure only left with 1 /Root
+        ' Warning: objectCache is used to convert references to objs, so do not attempt to retrieve any
+        ' objects via obj reference after removing them from objectCache
+        pdfDoc.objectCache.Remove pdfDoc.rootCatalog.id
+        ' also need to remove /Info from cache
+        If pdfDoc.objectCache.Exists(pdfDoc.Info.id) Then
+            pdfDoc.objectCache.Remove pdfDoc.Info.id
+        End If
+        ' and now save all the pages and other non-toplevel objects to our combined document
         combinedPdfDoc.SavePdfObjects outputFileNum, pdfDoc.objectCache, offset
 
         ' determine highest id used, 1st obj in next file will start at this + 1
@@ -75,12 +72,6 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
         DoEvents
     Next ndx
 
-    ' we need to set valid id's for our top level objs
-    With combinedPdfDoc
-        .Info.id = .nextObjId
-        .rootCatalog.id = .nextObjId
-    End With
-    
     ' save updated /Pages object (but not nested objects as already saved)
     combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.pages, offset
     combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.rootCatalog, offset
@@ -92,18 +83,6 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
 End Sub
 
 
-' simple function lets user pick files to combine
-Public Sub PickAndCombinePdfFiles()
-    Dim files() As String
-    files = PickFiles()
-    Dim ufFileOrder As ufFileList: Set ufFileOrder = New ufFileList
-    ufFileOrder.list = files
-    ufFileOrder.Show
-    files = ufFileOrder.list
-    CombinePDFs files, "combined.pdf"
-End Sub
-
-
 'Create a FileDialog object as a File Picker dialog box and returns String array of files selected.
 Function PickFiles(Optional ByVal AllowMultiSelect As Boolean = True) As String()
     Dim fd As FileDialog

src/pdfLib.xlsm/Forms/ufPdfInfo.frm

@@ -137,6 +137,7 @@ Function GetWord(ByRef bytes() As Byte, ByRef offset As Long) As String
 errHandler:
     Debug.Print "Error: " & Err.Description & " (" & Err.Number & ")"
     Stop
+    Resume
 End Function