TSpdfUtils/TSPdfUtils/Utilidades.vb

Imports System.IO
Imports System.Text
Imports TSpdf.Kernel.Pdf
Imports TSpdf.Kernel.Utils
Imports TSpdf.Pdfa

Public Class Utilidades
    'Convierte un pdf normal en el formato pdf_A_3B
    Public Shared Function crearPDFA(ByVal pdfOrigen As Stream) As MemoryStream

        Dim reader As New PdfReader(pdfOrigen)
        Dim ms As New MemoryStream

        Dim writerProps As New WriterProperties()
        writerProps.SetPdfVersion(PdfVersion.PDF_2_0)

        Dim writer As New PdfWriter(ms, writerProps)
        writer.SetSmartMode(True)
        ' Necesario para que el memorystream no se cierre y siga abieto
        writer.SetCloseStream(False)

        Dim sourcePdf As New PdfDocument(reader)

        Dim esRGB As Boolean = recorrerPaginas(sourcePdf)

        For page As Integer = 1 To sourcePdf.GetNumberOfPages()

            Dim paginaActual = sourcePdf.GetPage(page)
            Dim anotaciones = paginaActual.GetAnnotations()

            If anotaciones IsNot Nothing Then

                For Each anotacionActual In anotaciones
                    Dim diccionario = anotacionActual.GetPdfObject()

                    If Not diccionario.ContainsKey(PdfName.F) Then
                        diccionario.Put(PdfName.F, New PdfNumber(4))
                    End If
                Next
            End If


        Next

        Dim disPDF As PdfADocument

        'If esRGB Then

        '    disPDF = New PdfADocument(writer, PdfAConformanceLevel.PDF_A_3B,
        '    New PdfOutputIntent("Custom", "", "https://www.color.org", "sRGB",
        '    New MemoryStream(My.Resources.sRGB2014)))

        'Else
        '    disPDF = New PdfADocument(writer, PdfAConformanceLevel.PDF_A_3B,
        '                New PdfOutputIntent("Custom", "", "https://www.color.org", "FOGRA39",
        '                New MemoryStream(My.Resources.Fogra39L)))
        'End If

        disPDF = New PdfADocument(writer, PdfAConformanceLevel.PDF_A_3B,
       New PdfOutputIntent("Custom", "", "https://www.color.org", "sRGB",
       New MemoryStream(My.Resources.sRGB2014)))



        disPDF.InitializeOutlines()
        ' Configurar parámetros requeridos
        disPDF.SetTagged()
        disPDF.GetCatalog().SetLang(New PdfString("es-ES"))
        disPDF.GetCatalog().SetViewerPreferences(New PdfViewerPreferences().SetDisplayDocTitle(True))

        Dim merger As New PdfMerger(disPDF, True, True)
        merger.Merge(sourcePdf, 1, sourcePdf.GetNumberOfPages())

        sourcePdf.Close()
        disPDF.Close()
        reader.Close()
        writer.Close()

        ' Esto hace falta para volver al inicio del memorystream
        ms.Position = 0

        Return ms
    End Function
    Public Shared Function controlarInterpolate(ByVal resources As PdfDictionary, ByVal tieneRGB As Boolean) As Boolean


        Dim xObjects = resources?.GetAsDictionary(PdfName.XObject)
        Dim tieneRGBActual As Boolean = tieneRGB

        If xObjects IsNot Nothing Then
            For Each key In xObjects.KeySet()
                Dim stream = xObjects.GetAsStream(key)
                Dim subtype = stream.GetAsName(PdfName.Subtype)

                If PdfName.Image.Equals(subtype) Then

                    If stream.GetAsBoolean(PdfName.Interpolate)?.GetValue = True Then

                        stream.Put(PdfName.Interpolate, PdfBoolean.FALSE)
                    End If

                    Dim colorSpace = stream.Get(PdfName.ColorSpace)

                    If colorSpace IsNot Nothing AndAlso colorSpace.Equals(PdfName.DeviceRGB) Then
                        tieneRGBActual = True
                        tieneRGB = True
                    End If

                ElseIf PdfName.Form.Equals(subtype) Then

                    Dim formRes = stream.GetAsDictionary(PdfName.Resources)

                    If formRes IsNot Nothing Then
                        Dim hijoTieneRGB As Boolean = controlarInterpolate(formRes, tieneRGBActual)

                        If hijoTieneRGB Then
                            tieneRGBActual = True
                        End If
                    End If

                End If
            Next
        End If

        Return tieneRGBActual
    End Function



    Public Shared Function recorrerPaginas(ByVal pdf As PdfDocument) As Boolean
        Dim tieneRGB As Boolean = False

        For i As Integer = 1 To pdf.GetNumberOfPages
            Dim rgbMinimo As Boolean = False

            Dim diccPaginaActual = pdf.GetPage(i).GetResources().GetPdfObject()
            rgbMinimo = controlarInterpolate(diccPaginaActual, tieneRGB)

            If rgbMinimo Then
                tieneRGB = True
            End If
        Next

        Return tieneRGB
    End Function
    Public Shared Sub RepararAnotacionesSinF(pdfDoc As PdfDocument)

        For page As Integer = 1 To pdfDoc.GetNumberOfPages()

            Dim paginaActual = pdfDoc.GetPage(page)
            Dim anotaciones = paginaActual.GetAnnotations()

            If anotaciones IsNot Nothing Then
                For Each anotacionActual In anotaciones
                    Dim diccionario = anotacionActual.GetPdfObject()

                    If Not diccionario.ContainsKey(PdfName.F) Then
                        diccionario.Put(PdfName.F, New PdfNumber(4))
                    End If
                Next
            End If

        Next

    End Sub


    Public Shared Function TieneMarcaPdfA(pdfStream As Stream) As Boolean
        Try
            If pdfStream Is Nothing Then Return False

            If pdfStream.CanSeek Then
                pdfStream.Position = 0
            End If

            Using reader As New PdfReader(pdfStream)
                Using pdf As New PdfDocument(reader)

                    Dim metadata As Byte() = pdf.GetXmpMetadata()

                    If metadata Is Nothing OrElse metadata.Length = 0 Then
                        Return False
                    End If

                    Dim xmpString As String = Encoding.UTF8.GetString(metadata)

                    Return xmpString.Contains("pdfaid:part")
                End Using
            End Using

        Catch
            Return False
        End Try
    End Function
End Class