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