improve Outlines (bookmarks) created when combining multiple PDFs, other minor updates

Author: PerditionC

dist/CombinePDF.xlsm

@@ -23,7 +23,7 @@ Public Property Get Length() As Long
     ' Length is stored in meta
     ' it should be same as size of data
     If Meta.Exists("/Length") Then
-        Length = CLng(Meta.Item("/Length").value)
+        Length = CLng(Meta.item("/Length").value)
     End If
 
     On Error Resume Next
@@ -38,17 +38,17 @@ Public Property Get Length() As Long
 End Property
 
 ' this will add/update /Length property in meta and resize data()
-Public Property Let Length(ByVal Count As Long)
-    Meta("/Length").value = Count ' add or replace
+Public Property Let Length(ByVal count As Long)
+    Meta("/Length").value = count ' add or replace
 
     On Error Resume Next
     Dim dataLen As Long
     dataLen = UBound(data) - LBound(data)
     On Error GoTo 0
     If Err.Number = 9 Then ' array out of bounds, i.e. not initialized
-        ReDim data(0 To Count)
-    ElseIf dataLen <> Count Then ' no need to adjust size if unchanged (ie just setting meta /Length property
-        ReDim Preserve data(0 To Count) ' keep any data there, allows extending
+        ReDim data(0 To count)
+    ElseIf dataLen <> count Then ' no need to adjust size if unchanged (ie just setting meta /Length property
+        ReDim Preserve data(0 To count) ' keep any data there, allows extending
     End If
 End Property
 
@@ -66,13 +66,13 @@ Public Property Get udata() As Byte()
         If Meta.Exists("/Filter") Then
             ' TODO support all /Filter types
             Dim filter As String
-            filter = Meta.Item("/Filter").value
+            filter = Meta.item("/Filter").value
             Select Case LCase(filter)
                 Case "/flatedecode"
                     Dim startIndex As Long: startIndex = 2 ' skip past zlib wrapper to raw Deflate data
                     Dim outSize As Long ' as count of bytes -- should be 0 on entry so will be size on output
                     Dim estBufSize As Long ' if known, uncompressed size
-                    If Meta.Exists("/DL") Then estBufSize = CLng(Meta.Item("/DL").value) ' only a hint
+                    If Meta.Exists("/DL") Then estBufSize = CLng(Meta.item("/DL").value) ' only a hint
                     Erase m_udata
 
                     ' Note: libdeflate_inflate arguments are byVal, we expect them be byRef
@@ -88,16 +88,16 @@ Public Property Get udata() As Byte()
                     predictor = 1: columns = 1
                     If Meta.Exists("/DecodeParms") Then
                         Dim pdfV As pdfValue
-                        Set pdfV = Meta.Item("/DecodeParms")
+                        Set pdfV = Meta.item("/DecodeParms")
                         Dim decodeParms As Dictionary
                         Set decodeParms = pdfV.value
                         If decodeParms.Exists("/Predictor") Then
-                            Set pdfV = decodeParms.Item("/Predictor")
+                            Set pdfV = decodeParms.item("/Predictor")
                             predictor = pdfV.value
                         End If
                         ' should only be supplied if predictor > 1, but we can load value regardless, only used if predictor > 1
                         If decodeParms.Exists("/Columns") Then
-                            Set pdfV = decodeParms.Item("/Columns")
+                            Set pdfV = decodeParms.item("/Columns")
                             columns = pdfV.value
                         End If
                         Set pdfV = Nothing

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

@@ -18,6 +18,15 @@ Public value As Variant
 ' to help maintain id across indirect references, PDF_Object provides a PDF_Reference object to be used by others
 Private m_referenceObj As pdfValue
 
+' used to help encode certain information about how to represent
+Public Enum ValueFlags
+    flgNone = 0
+    flgUtf8 = 1
+    flgBinary = 2
+End Enum
+
+Public flags As ValueFlags
+
 
 ' keep our referencObj in sync
 Public Property Let id(ByVal newId As Long)
@@ -122,7 +131,7 @@ Private Function pdfStringToBytes(ByRef str As String, Optional ByVal asHex As B
     ' we need to check if any Unicode values and if so we encode in UTF-8
     ' to avoid more expensive check if >255 value used, we simply always encode as UTF-8 unless ASCII (all values < 128)
     ucBytes = StringToUtf8Bytes(str, BOM:=False)  ' Note: if only ASCII then equivalent to UTF-8 byte array
-    If UBound(ucBytes) > strLen Then ucBytes = AddUtf8BOM(ucBytes)    ' something >128 and had to be expanded to multiple bytes
+    If UBound(ucBytes) > strLen Then ucBytes = addUtf8BOM(ucBytes)    ' something >128 and had to be expanded to multiple bytes
 
     Dim ndx As Long
     ' now determine if we are returning bytes as (string) or <## ## ##> format
@@ -186,7 +195,7 @@ Public Function serialize(Optional ByVal baseId As Long = 0) As Byte()
         Case PDF_ValueType.PDF_Null
             objStr = "null"
         Case PDF_ValueType.PDF_Name
-            objStr = value.value
+            objStr = pdfDocument.EscapeName(value.value, value.flags And flgUtf8)  ' see below where Dictionary Key Name encoded
         Case PDF_ValueType.PDF_Boolean
             If value.value Then
                 objStr = "true"
@@ -222,12 +231,12 @@ Public Function serialize(Optional ByVal baseId As Long = 0) As Byte()
                 If Not firstPass Then objStr = objStr & vbLf
                 firstPass = False
                 Dim key As String
-                If TypeName(v) = "String" Then
+                If typeName(v) = "String" Then
                     key = CStr(v)
-                Else ' assume pdfValue with valueType=PDF_Name
-                    key = CStr(v.value)
+                Else 'If typeName(v) = "pdfValue" Then ' assume pdfValue with valueType=PDF_Name
+                        key = pdfDocument.EscapeName(v.value, v.flags And flgUtf8)
                 End If
-                Set pv = dict.Item(key)
+                Set pv = dict.item(v) ' v may be pdfValue or String version of key
                 objStr = objStr & key & " "
                 objStr = objStr & BytesToString(pv.serialize(baseId))
             Next v
@@ -285,8 +294,10 @@ End Function
 ' can be used by predeclared object, e.g. pdfValue.NewValueObj("/MyName", "/Name")
 
 ' returns a name as a pdfValue /Name obj
-Function NewNameValue(ByVal name As String) As pdfValue
+Function NewNameValue(ByVal name As String, Optional ByVal utf8 As Boolean = False) As pdfValue
+    If Left$(name, 1) <> "/" Then name = "/" & name
     Set NewNameValue = NewValue(name, "/Name")
+    If utf8 Then NewNameValue.flags = flgUtf8
 End Function
 
 
@@ -307,12 +318,12 @@ Function NewValue(ByRef value As Variant, Optional ByRef valueType As String = v
     Select Case VarType(value)
         Case vbNull
             ' always return same instance for Null
-            Static NullValue As pdfValue
-            If NullValue Is Nothing Then
+            Static nullValue As pdfValue
+            If nullValue Is Nothing Then
                 obj.valueType = PDF_ValueType.PDF_Null
-                Set NullValue = obj
+                Set nullValue = obj
             Else
-                Set obj = NullValue
+                Set obj = nullValue
             End If
         Case vbLong, vbInteger
             obj.valueType = PDF_ValueType.PDF_Integer
@@ -335,7 +346,7 @@ Function NewValue(ByRef value As Variant, Optional ByRef valueType As String = v
                     obj.value = CStr(value)
             End Select
         Case vbObject
-            Select Case TypeName(value)
+            Select Case typeName(value)
                 Case "Dictionary"
                     obj.valueType = PDF_ValueType.PDF_Dictionary
                     Set obj.value = value

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

@@ -51,7 +51,7 @@ Private Sub UpdateInfo()
         Dim v As Variant
         Dim obj As pdfValue
         For Each v In dict.Keys
-            lbInfo.AddItem CStr(v) & "=" & dict.Item(v).value
+            lbInfo.AddItem CStr(v) & "=" & dict.item(v).value
         Next v
     End If
 End Sub
@@ -60,6 +60,23 @@ Private Sub UpdatePages()
     lblPageCount = pdfDoc.pageCount
 End Sub
 
+Private Sub UpdateNamedDestinations()
+    If pdfDoc.Dests.valueType = PDF_ValueType.PDF_Dictionary Then
+        Dim dict As Dictionary: Set dict = pdfDoc.Dests.asDictionary()
+        If Not dict Is Nothing Then
+            Dim v As Variant
+            Dim obj As pdfValue
+            For Each v In dict.Keys
+                Set obj = dict(v)
+                lbNamedDestinations.AddItem CStr(v) & ":" & BytesToString(obj.serialize())
+            Next v
+            Set v = Nothing
+        End If
+        Set dict = Nothing
+    End If
+End Sub
+
+
 
 Private Sub UserForm_Activate()
     ' auto prompt for file to load if not passed programatically beforehand
@@ -75,5 +92,6 @@ Private Sub UserForm_Activate()
         lblFilename.Caption = pdfDoc.filepath & pdfDoc.filename
         UpdateInfo
         UpdatePages
+        UpdateNamedDestinations
     End If
 End Sub

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

@@ -17,11 +17,13 @@ End Sub
 Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
     Dim combinedPdfDoc As pdfDocument: Set combinedPdfDoc = New pdfDocument
     ' initialize with some basic structures
-    combinedPdfDoc.AddInfo
-    combinedPdfDoc.AddPages
-    combinedPdfDoc.AddOutlines
-    With combinedPdfDoc.rootCatalog.asDictionary()
-        Set .Item("/PageMode") = pdfValue.NewNameValue("/UseOutlines") ' default is "/UseNone"
+    With combinedPdfDoc
+        .AddInfo
+        .AddPages
+        .AddOutlines
+        With .rootCatalog.asDictionary()
+            Set .item("/PageMode") = pdfValue.NewNameValue("/UseOutlines") ' default is "/UseNone"
+        End With
     End With
 
     Dim offset As Long
@@ -42,16 +44,53 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
         pdfDoc.parsePdf
 
         ' adjust obj id's so no conflict with previously stored ones
-        pdfDoc.renumberIds baseId
+        pdfDoc.renumberIds baseId + 1   ' +1 as baseId used for our /OutlineItem
 
+        ' add the first page of this document as a Named Destination to our combined pdf
+        ' Note: we assume current pageCount is how many existing pages there are, with
+        ' the next page being 1st of just loaded document, then subtract 1 as page# begins with 0
+        Dim docDestinationName As pdfValue
+        Set docDestinationName = pdfValue.NewNameValue("/" & pdfDoc.Title & ".1", utf8:=True)
+        Dim docDestination As pdfValue
+        Set docDestination = combinedPdfDoc.NewDestination(combinedPdfDoc.pageCount, PDF_FIT.PDF_FIT)
+        combinedPdfDoc.AddNamedDestinations docDestinationName, docDestination
+            
+        ' copy over any pre-existing Named Destinations
+        ' Note: these are in a <<dictionary>> in /Root/Pages so not automatically included
+        If pdfDoc.Dests.valueType = PDF_ValueType.PDF_Dictionary Then
+            Dim dict As Dictionary: Set dict = pdfDoc.Dests.asDictionary()
+            If Not dict Is Nothing Then
+                Dim v As Variant
+                For Each v In dict.Keys
+                    ' we treat name as PDF_String instead of PDF_Name to avoid potential double escaping
+                    ' and because while PDF_Name recommended, not required so could just be a PDF_String
+                    Dim name As pdfValue: Set name = pdfValue.NewValue(v)
+                    combinedPdfDoc.AddNamedDestinations name, dict(v)
+                Next v
+                Set v = Nothing
+            End If
+            Set dict = Nothing
+        End If
+        
         ' 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
+        combinedPdfDoc.AddPages pdfDoc.Pages
 
         ' we need to copy/merge some optional fields such as /Outline for bookmarks
-        If pdfDoc.rootCatalog.hasKey("/Outlines") Then
+        If False And pdfDoc.rootCatalog.hasKey("/Outlines") Then
+            ' Note: these are objs in pdfDoc so we need to remove if we add equivalent ones to combindedPdfDoc to avoid duplicates
             ' hack for now, just copy over
-            combinedPdfDoc.rootCatalog.asDictionary().Add "/Outlines", pdfDoc.rootCatalog.asDictionary().Item("/Outlines")
+            'combinedPdfDoc.rootCatalog.asDictionary().Add "/Outlines", pdfDoc.rootCatalog.asDictionary().item("/Outlines")
+            ' TODO
+        Else
+            ' defaults should include /First /Last along with /Count, /Title /Prev /Next and optionally /Dest
+            Dim defaults As Dictionary: Set defaults = New Dictionary
+            Set defaults("/Title") = pdfValue.NewValue(pdfDoc.Title)
+            Set defaults("/Dest") = docDestinationName
+            Dim outlineItem As pdfValue
+            Set outlineItem = combinedPdfDoc.NewOutlineItem(combinedPdfDoc.Outlines, defaults)
+            combinedPdfDoc.AddOutlines outlineItem
+            ' don't save here as we may need to adjust /Prev & /Next values
         End If
 
         ' remove /Root object and ensure only left with 1 /Root
@@ -67,13 +106,28 @@ Public Sub CombinePDFs(ByRef sourceFiles() As String, ByRef outFile As String)
 
         ' determine highest id used, 1st obj in next file will start at this + 1
         ' Note: we need to use pdfDoc.xrefTable's size and not combinedPdfDoc.xrefTable as we are reserving full count from just loaded pdf document
-        baseId = baseId + pdfDoc.xrefTable.Count - 1 ' highest id possible so far
+        baseId = baseId + pdfDoc.xrefTable.count - 1 ' highest id possible so far
         combinedPdfDoc.nextObjId = baseId + 1
         DoEvents
     Next ndx
 
+    combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.Outlines, offset
+    If combinedPdfDoc.Outlines.hasKey("/First") Then
+        Dim outlineObj As pdfValue
+        Set outlineObj = combinedPdfDoc.Outlines.asDictionary().item("/First")
+        Set outlineObj = combinedPdfDoc.getObject(outlineObj.value, outlineObj.generation)
+        Do While Not outlineObj Is Nothing
+            combinedPdfDoc.SavePdfObject outputFileNum, outlineObj, offset
+            If outlineObj.hasKey("/Next") Then
+                Set outlineObj = outlineObj.asDictionary().item("/Next")
+                Set outlineObj = combinedPdfDoc.getObject(outlineObj.value, outlineObj.generation)
+            Else
+                Set outlineObj = Nothing
+            End If
+        Loop
+    End If
     ' save updated /Pages object (but not nested objects as already saved)
-    combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.pages, offset
+    combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.Pages, offset
     combinedPdfDoc.SavePdfObject outputFileNum, combinedPdfDoc.rootCatalog, offset
 
     ' writes out trailer and cross reference table
@@ -101,9 +155,9 @@ Function PickFiles(Optional ByVal AllowMultiSelect As Boolean = True) As String(
         If .Show = -1 Then
             'Step through each string in the FileDialogSelectedItems collection.
             Dim files() As String
-            ReDim files(0 To .SelectedItems.Count - 1)
+            ReDim files(0 To .SelectedItems.count - 1)
             Dim ndx As Long
-            For ndx = 1 To .SelectedItems.Count
+            For ndx = 1 To .SelectedItems.count
                 files(ndx - 1) = .SelectedItems(ndx)
             Next ndx
             PickFiles = files

src/pdfLib.xlsm/Forms/ufFileList.frx

@@ -45,7 +45,7 @@ Sub TestProblemPdfs()
         Debug.Print "Error parsing pdf " & pdfDoc.filename
     End If
 
-    Debug.Print pdfDoc.pages.asDictionary.Item("/Count").value
+    Debug.Print pdfDoc.Pages.asDictionary.item("/Count").value
 
     Dim obj As pdfValue
     Set obj = pdfDoc.getObject(69, 0)
@@ -110,7 +110,7 @@ Sub TestZip()
             Debug.Print Err.Description & " (" & Err.Number & ")"
         Else
             For i = LBound(fileContent) To UBound(fileContent)
-                Debug.Print Chr(fileContent(i));
+                Debug.Print chr(fileContent(i));
                 If fileContent(i) = 10 Then Debug.Print ""
             Next i
         End If

src/pdfLib.xlsm/Forms/ufPdfInfo.frm

@@ -88,7 +88,7 @@ End Function
 Function GetDictionaryValue(ByRef value As pdfValue, ByVal name As String) As pdfValue
     On Error GoTo errHandler
     If value.value.Exists(name) Then
-        Set GetDictionaryValue = value.value.Item(name)
+        Set GetDictionaryValue = value.value.item(name)
     Else
         Set GetDictionaryValue = New pdfValue   ' defaults to PDF_ValueType.PDF_Null
     End If