Agregar archivos de proyecto.

This commit is contained in:
2026-05-14 08:45:02 +02:00
parent 0bf9686303
commit 371937db13
129 changed files with 100769 additions and 0 deletions

376
Utilidades/Docx.vb Normal file
View File

@@ -0,0 +1,376 @@
Imports System.Data.OleDb
Imports DevExpress.Office.Services
'Imports DevExpress.Web
Imports DevExpress.XtraPrinting
Imports DevExpress.XtraRichEdit
Imports DevExpress.XtraRichEdit.Native
Imports DevExpress.XtraRichEdit.Model
Imports DevExpress.XtraReports.UI
Imports System.Data
Namespace Utilidades
Public Class Docx
Public Shared Function CombinaDocx(tabla As DataTable, Plantilla() As Byte, FormatoPDF As Boolean) As IO.MemoryStream
Try
Dim ms As New IO.MemoryStream
'Dim fs As New IO.FileStream("c:\tmp\pruebamerge.docx", IO.FileMode.Create)
Utilidades.Docx.Combinar(New IO.MemoryStream(Plantilla), tabla, ms, 0, tabla.Rows.Count, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
ms.Seek(0, IO.SeekOrigin.Begin)
'Dim fs As New IO.FileStream("c:\tmp\ms.docx", IO.FileMode.Create)
'ms.WriteTo(fs)
'fs.Close()
If FormatoPDF Then
Return Utilidades.Docx.ExportarApdf(ms)
Else
Return ms
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Public Shared Function CombinaDocx(tabla As DataTable, Plantilla() As Byte, FormatoPDF As Boolean, Optional NumRegBloque As Integer = 1000) As Byte()
Try
If FormatoPDF Then
' Throw New Exception("Exportación a pdf aún no soportada")
Dim iNumBloques As Integer = (Int((tabla.Rows.Count - 1) / NumRegBloque)) - 1
If tabla.Rows.Count Mod NumRegBloque > 1 Then iNumBloques += 1
Dim sp(iNumBloques) As String
Dim sd(iNumBloques) As String
Dim p As New IO.MemoryStream(Plantilla)
Dim iRegIni As Integer
Dim iRegFin As Integer
For i = 0 To iNumBloques
sd(i) = tsl5.Utilidades.ObtieneFicheroAleatorio("docx")
sp(i) = tsl5.Utilidades.ObtieneFicheroAleatorio("pdf")
Dim fs As New IO.FileStream(sd(i), IO.FileMode.CreateNew, IO.FileAccess.Write)
iRegIni = i * NumRegBloque
iRegFin = Math.Min((i * NumRegBloque) + NumRegBloque - 1, tabla.Rows.Count - 1)
Debug.WriteLine(Now.ToString & " Bloque " & i.ToString & " " & iRegIni & "-" & iRegFin)
p = New IO.MemoryStream(Plantilla)
Utilidades.Docx.Combinar(p, tabla, fs, iRegIni, iRegFin, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
fs.Close()
GC.Collect()
GC.WaitForPendingFinalizers()
Debug.WriteLine(Now.ToString & " Bloque " & i.ToString & " " & iRegIni & "-" & iRegFin & " a pdf")
Utilidades.Docx.ExportarApdf(sd(i), sp(i))
Debug.WriteLine(Now.ToString & " Fin Bloque " & i.ToString & " " & iRegIni & "-" & iRegFin & " a pdf")
GC.Collect()
GC.WaitForPendingFinalizers()
' fs.Close()
Next
Dim msPdfUnidos As New IO.MemoryStream
TSpdfUtils.pdf.UnePdfs(sp, msPdfUnidos)
msPdfUnidos.Seek(0, 0)
Return msPdfUnidos.ToArray
Else
Dim sdocx As String
Do
sdocx = tsl5.Utilidades.ObtieneFicheroAleatorio("docx")
Loop Until Not IO.File.Exists(sdocx)
Dim fs As New IO.FileStream(sdocx, IO.FileMode.CreateNew, IO.FileAccess.Write)
Utilidades.Docx.Combinar(New IO.MemoryStream(Plantilla), tabla, fs, 0, tabla.Rows.Count, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
fs.Close()
Return IO.File.ReadAllBytes(sdocx) ' tsl5.Ficheros.FicheroAArrayBytes(sdocx)
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Public Shared Sub Combinar(Plantilla As IO.Stream, Datos As Object, Destino As IO.Stream, PrimerRegistro As Integer, UltimoRegistro As Integer, Formato As DevExpress.XtraRichEdit.DocumentFormat)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(Plantilla, Formato)
Dim options = docServer.CreateMailMergeOptions()
options.FirstRecordIndex = PrimerRegistro
options.LastRecordIndex = UltimoRegistro
options.MergeMode = API.Native.MergeMode.NewSection
docServer.Options.MailMerge.DataSource = Datos
docServer.Options.MailMerge.ViewMergedData = True
docServer.Options.Export.Html.EmbedImages = True
docServer.Options.MailMerge.ActiveRecord = 0
docServer.MailMerge(options, Destino, Formato)
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
Public Shared Sub ExportarApdf(FicheroOrigen As String, FicheroDestino As String)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(FicheroOrigen, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
docServer.Options.Export.Html.EmbedImages = True
'Dim po As New PdfExportOptions
'po.Compressed = True
'po.PageRange = "1-10"
Dim fs As New IO.FileStream(FicheroDestino, IO.FileMode.Create, IO.FileAccess.Write)
docServer.ExportToPdf(fs)
fs.Close()
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
Public Shared Sub ExportarApdf(Documento As IO.Stream, Destino As IO.Stream)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(Documento, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
docServer.Options.Export.Html.EmbedImages = True
Dim po As New PdfExportOptions
po.Compressed = True
'po.PageRange = "1-10"
docServer.ExportToPdf(Destino, po)
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
Public Shared Function UneDocx(ByVal FicheroCabeceraYPie As Byte(), ByVal FicherosAUnir As List(Of Byte()), FormatoDestino As DevExpress.XtraRichEdit.DocumentFormat, FormaUnion As ModoUnion) As IO.MemoryStream
Dim ds As New RichEditDocumentServer()
ds.LoadDocument(New IO.MemoryStream(FicheroCabeceraYPie), DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
For i = 0 To FicherosAUnir.Count - 1
ds.Document.AppendDocumentContent(New IO.MemoryStream(FicherosAUnir(i)))
Next
Dim ms As New IO.MemoryStream
ds.SaveDocument(ms, DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
If ms.CanSeek Then ms.Seek(0, 0)
Return ms
End Function
Public Shared Function UneDocx(ByVal FicherosAUnir As List(Of Byte()), FormatoDestino As DevExpress.XtraRichEdit.DocumentFormat, FormaUnion As ModoUnion) As IO.MemoryStream
Dim targetServer = UneDocx(FicherosAUnir, FormaUnion)
Dim ms As New IO.MemoryStream
targetServer.SaveDocument(ms, FormatoDestino)
If ms.CanSeek Then ms.Seek(0, 0)
Return ms
'If FicherosAUnir.Count = 1 Then
' Return New IO.MemoryStream(FicherosAUnir.First)
'Else
' Dim ds As New RichEditDocumentServer()
' ds.LoadDocument(New IO.MemoryStream(FicherosAUnir.First), DocumentFormat.OpenXml)
' For i = 1 To FicherosAUnir.Count - 1
' ds.Document.AppendDocumentContent(New IO.MemoryStream(FicherosAUnir(i)))
' Next
' Dim ms As New IO.MemoryStream
' ds.SaveDocument(ms, DocumentFormat.OpenXml)
' ms.Seek(0, 0)
' Return ms
'End If
End Function
Public Shared Sub UneDocx(ByVal FicherosAUnir As List(Of String), FicheroDestino As String, FormatoDestino As DevExpress.XtraRichEdit.DocumentFormat, FormaUnion As ModoUnion)
Dim targetServer = UneDocx(FicherosAUnir, FormaUnion)
targetServer.SaveDocument(FicheroDestino, FormatoDestino)
End Sub
Public Shared Function UneDocx(ByVal Ficheros As List(Of String), FormaUnion As ModoUnion) As DevExpress.XtraRichEdit.API.Native.Document
Dim targetServer As New RichEditDocumentServer()
Dim sourceServer As New RichEditDocumentServer()
Dim targetDoc As DevExpress.XtraRichEdit.API.Native.Document = targetServer.Document
Dim sourceDoc As DevExpress.XtraRichEdit.API.Native.Document = sourceServer.Document
For i As Integer = 0 To Ficheros.Count - 1
sourceServer.LoadDocument(Ficheros(i))
targetDoc.Sections(targetDoc.Sections.Count - 1).UnlinkHeaderFromPrevious()
targetDoc.Sections(targetDoc.Sections.Count - 1).UnlinkFooterFromPrevious()
Append(sourceDoc, targetDoc, (i = 0 And FormaUnion = ModoUnion.CABECERA_Y_PIE_SOLO_PRIMER_FICHERO Or FormaUnion = ModoUnion.CABECERA_Y_PIE_EN_TODOS_LOS_FICHEROS))
If i = Ficheros.Count - 1 Then
Return targetDoc
End If
targetDoc.AppendSection()
Next i
Return targetDoc
End Function
Public Enum ModoUnion As Integer
CABECERA_Y_PIE_EN_TODOS_LOS_FICHEROS = 0
CABECERA_Y_PIE_SOLO_PRIMER_FICHERO = 1
SIN_CABECERA_NI_PIE = 2
End Enum
Public Shared Function UneDocx(ByVal Ficheros As List(Of Byte()), FormaUnion As ModoUnion) As DevExpress.XtraRichEdit.API.Native.Document
Dim targetServer As New RichEditDocumentServer()
Dim sourceServer As New RichEditDocumentServer()
Dim targetDoc As DevExpress.XtraRichEdit.API.Native.Document = targetServer.Document
Dim sourceDoc As DevExpress.XtraRichEdit.API.Native.Document = sourceServer.Document
For i As Integer = 0 To Ficheros.Count - 1
sourceServer.LoadDocument(New IO.MemoryStream(Ficheros(i)))
targetDoc.Sections(targetDoc.Sections.Count - 1).UnlinkHeaderFromPrevious()
targetDoc.Sections(targetDoc.Sections.Count - 1).UnlinkFooterFromPrevious()
Append(sourceDoc, targetDoc, (i = 0 And FormaUnion = ModoUnion.CABECERA_Y_PIE_SOLO_PRIMER_FICHERO Or FormaUnion = ModoUnion.CABECERA_Y_PIE_EN_TODOS_LOS_FICHEROS))
If i = Ficheros.Count - 1 Then
Return targetDoc
End If
targetDoc.AppendSection()
Next i
Return targetDoc
End Function
Private Shared Sub Append(ByVal source As DevExpress.XtraRichEdit.API.Native.Document, ByVal target As DevExpress.XtraRichEdit.API.Native.Document, AñadirCabecerasYPies As Boolean)
Dim lastSectionIndexBeforeAppending As Integer = target.Sections.Count - 1
Dim sourceSectionCount As Integer = source.Sections.Count
'target.AppendRtfText(source.RtfText)
Dim posicion = target.CreatePosition(target.Range.End.ToInt - 1)
' Dim posicion = target.CreatePosition(target.Paragraphs.Last.)
'target.InsertRtfText(posicion, source.RtfText)
target.DifferentOddAndEvenPages = source.DifferentOddAndEvenPages
If AñadirCabecerasYPies Then
For i As Integer = 0 To sourceSectionCount - 1
Dim sourceSection As DevExpress.XtraRichEdit.API.Native.Section = source.Sections(i)
Dim targetSection As DevExpress.XtraRichEdit.API.Native.Section = target.Sections(lastSectionIndexBeforeAppending + i)
' Copy header/footer
AppendHeader(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.Odd)
AppendFooter(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.Odd)
AppendHeader(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.Even)
AppendFooter(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.Even)
AppendHeader(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.First)
AppendFooter(sourceSection, targetSection, DevExpress.XtraRichEdit.API.Native.HeaderFooterType.First)
Next i
End If
End Sub
Private Shared Sub AppendHeader(ByVal sourceSection As DevExpress.XtraRichEdit.API.Native.Section, ByVal targetSection As DevExpress.XtraRichEdit.API.Native.Section, ByVal headerFooterType As DevExpress.XtraRichEdit.API.Native.HeaderFooterType)
If Not sourceSection.HasHeader(headerFooterType) Then
Return
End If
Dim source As DevExpress.XtraRichEdit.API.Native.SubDocument = sourceSection.BeginUpdateHeader(headerFooterType)
Dim target As DevExpress.XtraRichEdit.API.Native.SubDocument = targetSection.BeginUpdateHeader(headerFooterType)
target.Delete(target.Range)
target.InsertDocumentContent(target.Range.Start, source.Range, DevExpress.XtraRichEdit.API.Native.InsertOptions.KeepSourceFormatting)
' Delete empty paragraphs
Dim emptyParagraph As DevExpress.XtraRichEdit.API.Native.DocumentRange = target.CreateRange(target.Range.End.ToInt() - 1, 1)
target.Delete(emptyParagraph)
sourceSection.EndUpdateHeader(source)
targetSection.EndUpdateHeader(target)
End Sub
Private Shared Sub AppendFooter(ByVal sourceSection As DevExpress.XtraRichEdit.API.Native.Section, ByVal targetSection As DevExpress.XtraRichEdit.API.Native.Section, ByVal headerFooterType As DevExpress.XtraRichEdit.API.Native.HeaderFooterType)
If Not sourceSection.HasFooter(headerFooterType) Then
Return
End If
Dim source As DevExpress.XtraRichEdit.API.Native.SubDocument = sourceSection.BeginUpdateFooter(headerFooterType)
Dim target As DevExpress.XtraRichEdit.API.Native.SubDocument = targetSection.BeginUpdateFooter(headerFooterType)
target.Delete(target.Range)
target.InsertDocumentContent(target.Range.Start, source.Range, DevExpress.XtraRichEdit.API.Native.InsertOptions.KeepSourceFormatting)
' Delete empty paragraphs
Dim emptyParagraph As DevExpress.XtraRichEdit.API.Native.DocumentRange = target.CreateRange(target.Range.End.ToInt() - 1, 1)
target.Delete(emptyParagraph)
sourceSection.EndUpdateFooter(source)
targetSection.EndUpdateFooter(target)
End Sub
Public Shared Function CombinaDocxStream(Datos As Object, Plantilla() As Byte, PrimerRegistro As Integer, UltimoRegistro As Integer, FormatoPDF As Boolean) As IO.Stream
Try
Dim ms As New IO.MemoryStream
'Dim fs As New IO.FileStream("c:\tmp\pruebamerge.docx", IO.FileMode.Create)
Utilidades.Docx.Combinar(New IO.MemoryStream(Plantilla), Datos, ms, PrimerRegistro, UltimoRegistro, Global.DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
If ms.CanSeek Then ms.Seek(0, IO.SeekOrigin.Begin)
'Dim fs As New IO.FileStream("c:\tmp\ms.docx", IO.FileMode.Create)
'ms.WriteTo(fs)
'fs.Close()
If FormatoPDF Then
Return Utilidades.Docx.ExportarApdf(ms)
Else
Return ms
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Public Shared Function ExportarApdf(Docx As IO.Stream) As IO.MemoryStream
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(Docx, Global.DevExpress.XtraRichEdit.DocumentFormat.OpenXml)
docServer.Options.Export.Html.EmbedImages = True
Dim ms As New IO.MemoryStream
docServer.ExportToPdf(ms)
Dim po As New PdfExportOptions
po.Compressed = True
'Dim fs As New IO.FileStream("c:\tmp\pruebaexportada.pdf", IO.FileMode.Create)
'docServer.ExportToPdf(fs, po)
' fs.Close()
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Return ms
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
End Class
Public Class Pdf
Public Shared Sub DocumentoApdf(DocumentoOrigen As String, TipoDocumentoOrigen As DevExpress.XtraRichEdit.DocumentFormat, PdfDestino As String)
Try
Dim docServer As New RichEditDocumentServer
Dim fsOrigen As New IO.FileStream(DocumentoOrigen, IO.FileMode.Open, IO.FileAccess.Read)
Dim fsDestino As New IO.FileStream(PdfDestino, IO.FileMode.Create, IO.FileAccess.ReadWrite)
DocumentoApdf(fsOrigen, TipoDocumentoOrigen, fsDestino)
fsDestino.Close()
fsOrigen.Close()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
Public Shared Sub DocumentoApdf(DocumentoOrigen As IO.Stream, TipoDocumentoOrigen As DevExpress.XtraRichEdit.DocumentFormat, PdfDestino As IO.Stream)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(DocumentoOrigen, TipoDocumentoOrigen)
docServer.Options.Export.Html.EmbedImages = True
Dim po As New PdfExportOptions
po.Compressed = True
docServer.ExportToPdf(PdfDestino, po)
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Sub
End Class
End Namespace