Agregar archivos de proyecto.

This commit is contained in:
2026-05-27 17:48:50 +02:00
commit 905514c2a9
34 changed files with 8253 additions and 0 deletions

195
TSPdfUtils/Utilidades.vb Normal file
View File

@@ -0,0 +1,195 @@
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