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

308
Utilidades/Utilidades.vb Normal file
View File

@@ -0,0 +1,308 @@
Imports DevExpress.Xpf.LayoutControl
Imports System.Data
Imports System.Globalization
Imports System.IO
Imports System.Reflection
Namespace Utilidades
Public Class Varias
Public Shared Function DatatableAListaDeHahstable(Tabla As DataTable) As List(Of Hashtable)
Dim lht As New List(Of Hashtable)
For i = 0 To Tabla.Rows.Count - 1
Dim ht As New Hashtable
For j = 0 To Tabla.Columns.Count - 1
ht.Add(Tabla.Columns(j).ColumnName, Tabla.Rows(i)(j).ToString)
Next
lht.Add(ht)
Next
Return lht
End Function
Public Shared Sub EstableceSoloLecturaRecursivo(Objeto As Object, SoloLectura As Boolean)
For Each hijo In Objeto.Children
If hijo.GetType Is GetType(Control) Then
hijo.isEnabled = Not SoloLectura
ElseIf hijo.GetType Is GetType(LayoutGroup) Or hijo.GetType Is GetType(Grid) Then
EstableceSoloLecturaRecursivo(hijo, SoloLectura)
End If
Next
End Sub
Public Shared Function ByteArraytoBitmapImage(byteArray As [Byte]()) As BitmapImage
Dim stream As New MemoryStream(byteArray)
Dim bitmapImage As New BitmapImage()
bitmapImage.StreamSource = stream
Return bitmapImage
End Function
Public Shared Function StreamToBitmapImage(st As Stream) As BitmapImage
Dim bitmapImage As New BitmapImage()
bitmapImage.StreamSource = st
Return bitmapImage
End Function
Public Shared Function PrevInstance() As Boolean
Try
If UBound(Diagnostics.Process.GetProcessesByName(System.Diagnostics.Process.GetCurrentProcess.ProcessName)) > 0 Then
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
Public Shared Function GeneraExpresionBusquedaNoNulos(TextoAbuscar As String, CamposBusquedaNumericos() As String, CamposBusquedaAlfabeticos() As String, CamposBusquedaAlfabeticosPorIgualdad() As String, Optional CamposBusquedaAlfabeticosPorComienzo() As String = Nothing, Optional TipoBusqueda As String = "and") As String
Dim Expresion As String = ""
If TipoBusqueda = "and" Then
TipoBusqueda = "&&"
Else
TipoBusqueda = "||"
End If
Dim Palabras = TextoAbuscar.Trim.Split(" ").Where(Function(x) x.Trim <> "")
If CamposBusquedaNumericos IsNot Nothing Then
For Each palabra In Palabras
Dim Numero = palabra.Replace(",", ".")
If CamposBusquedaNumericos.Count > 0 AndAlso Double.TryParse(Numero, Nothing) Then
For Each c In CamposBusquedaNumericos
Expresion &= " || " & "(" & c & " !=null && " & c & "=" & Numero.TrimEnd(".") & ")"
Next
End If
Next
End If
If CamposBusquedaAlfabeticos IsNot Nothing Then
For Each c In CamposBusquedaAlfabeticos
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
palabra = palabra.Replace(Chr(34), """" & """")
ExpresionParcial &= " " & TipoBusqueda & " " & "(" & c & " != null && " & c & ".Contains(" & Chr(34) & palabra & Chr(34) & "))"
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(2 + TipoBusqueda.Length) & ")"
Expresion &= " || " & ExpresionParcial
Next
End If
If CamposBusquedaAlfabeticosPorIgualdad IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorIgualdad.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorIgualdad
ExpresionParcial &= " || " & "(" & c & " != null && " & c & "=" & Chr(34) & palabra & Chr(34) & ")"
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(2 + TipoBusqueda.Length) & ")"
Expresion &= " || " & ExpresionParcial
End If
If CamposBusquedaAlfabeticosPorComienzo IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorComienzo.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorComienzo
ExpresionParcial &= " " & TipoBusqueda & " " & "(" & c & " != null && " & c & ".StartsWith(" & Chr(34) & palabra & Chr(34) & "))"
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(2 + TipoBusqueda.Length) & ")"
Expresion &= " || " & ExpresionParcial
End If
If Expresion <> "" Then
Return Expresion.Substring(4)
Else
Return ""
End If
End Function
Public Shared Function GeneraExpresionBusqueda(TextoAbuscar As String, CamposBusquedaNumericos() As String, CamposBusquedaAlfabeticos() As String, CamposBusquedaAlfabeticosPorIgualdad() As String, Optional CamposBusquedaAlfabeticosPorComienzo() As String = Nothing, Optional TipoBusqueda As String = "and") As String
Dim Expresion As String = ""
Dim Palabras = TextoAbuscar.Trim.Split(" ").Where(Function(x) x.Trim <> "")
If CamposBusquedaNumericos IsNot Nothing Then
For Each palabra In Palabras
Dim Numero = palabra.Replace(",", ".")
If CamposBusquedaNumericos.Count > 0 AndAlso Double.TryParse(Numero, Nothing) Then
For Each c In CamposBusquedaNumericos
Expresion &= " or " & c & "=" & Numero.TrimEnd(".")
Next
End If
Next
End If
If CamposBusquedaAlfabeticos IsNot Nothing Then
For Each c In CamposBusquedaAlfabeticos
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
palabra = palabra.Replace(Chr(34), """" & """")
ExpresionParcial &= " " & TipoBusqueda & " " & c & ".Contains(" & Chr(34) & palabra & Chr(34) & ")"
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(2 + TipoBusqueda.Length) & ")"
Expresion &= " or " & ExpresionParcial
Next
End If
If CamposBusquedaAlfabeticosPorIgualdad IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorIgualdad.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorIgualdad
ExpresionParcial &= " or " & c & "=" & Chr(34) & palabra & Chr(34)
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(4) & ")"
Expresion &= " or " & ExpresionParcial
End If
If CamposBusquedaAlfabeticosPorComienzo IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorComienzo.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorComienzo
ExpresionParcial &= " " & TipoBusqueda & " " & c & ".StartsWith(" & Chr(34) & palabra & Chr(34) & ")"
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(1 + TipoBusqueda.Length) & ")"
Expresion &= " or " & ExpresionParcial
End If
If Expresion <> "" Then
Return Expresion.Substring(4)
Else
Return ""
End If
End Function
Public Shared Function GeneraExpresionBusqueda(TextoAbuscar As String, CamposBusquedaIntegers() As String, CamposBusquedaDoubles() As String, CamposBusquedaAlfabeticos() As String, CamposBusquedaAlfabeticosPorIgualdad() As String, ByRef Parametros() As Object, Optional CamposBusquedaAlfabeticosPorComienzo() As String = Nothing, Optional TipoBusqueda As String = "and") As String
Dim Expresion As String = ""
Dim Palabras = TextoAbuscar.Trim.Split(" ").Where(Function(x) x.Trim <> "")
Dim ContNum As Integer = 0
If CamposBusquedaIntegers IsNot Nothing Then
For Each palabra In Palabras
Dim Numero = palabra.Replace(",", ".")
If Numero.Contains(".") = False AndAlso CamposBusquedaIntegers.Count > 0 AndAlso Integer.TryParse(Numero, Nothing) Then
For Each c In CamposBusquedaIntegers
Expresion &= " or " & c & "=@" & ContNum.ToString
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = Integer.Parse(Numero, CultureInfo.InvariantCulture)
ContNum += 1
Next
End If
Next
End If
If CamposBusquedaDoubles IsNot Nothing Then
For Each palabra In Palabras
Dim Numero = palabra.Replace(",", ".")
If CamposBusquedaDoubles.Count > 0 AndAlso Double.TryParse(Numero, Nothing) Then
For Each c In CamposBusquedaDoubles
Expresion &= " or " & c & "=@" & ContNum.ToString
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = Double.Parse(Numero, CultureInfo.InvariantCulture)
ContNum += 1
Next
End If
Next
End If
If CamposBusquedaAlfabeticos IsNot Nothing Then
For Each c In CamposBusquedaAlfabeticos
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
palabra = palabra.Replace(Chr(34), "")
ExpresionParcial &= " " & TipoBusqueda & " " & c & ".Contains(" & "@" & ContNum.ToString & ")"
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = palabra
ContNum += 1
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(2 + TipoBusqueda.Length) & ")"
Expresion &= " or " & ExpresionParcial
Next
End If
If CamposBusquedaAlfabeticosPorIgualdad IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorIgualdad.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorIgualdad
ExpresionParcial &= " or " & c & "=" & "@" & ContNum.ToString
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = palabra
ContNum += 1
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(4) & ")"
Expresion &= " or " & ExpresionParcial
End If
If CamposBusquedaAlfabeticosPorComienzo IsNot Nothing Then
Dim ExpresionParcial As String = ""
For Each palabra In Palabras
If CamposBusquedaAlfabeticosPorComienzo.Count > 0 Then
For Each c In CamposBusquedaAlfabeticosPorComienzo
ExpresionParcial &= " " & TipoBusqueda & " " & c & ".StartsWith(" & "@" & ContNum.ToString & ")"
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = palabra
ContNum += 1
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(1 + TipoBusqueda.Length) & ")"
Expresion &= " or " & ExpresionParcial
End If
If Expresion <> "" Then
Return Expresion.Substring(4)
Else
Return ""
End If
End Function
Public Shared Function IEnumerableAExcelAgrupado(Of t)(Datos As List(Of t)) As Byte()
Dim ngc As New tsGridControl
ngc.View = New tsTableView()
DirectCast(ngc.View, tsTableView).AutoWidth = True
Dim lc = Datos.GetType.GetProperties.ToList
For Each oc In lc
Dim gc As New tsGridColumn()
gc.FieldName = oc.Name
gc.Header = oc.Name
ngc.Columns.Add(gc)
Next
ngc.ItemsSource = Datos
Dim ms As New MemoryStream
ngc.View.ExportToXlsx(ms)
ms.Position = 0
Return ms.ToArray
End Function
Public Shared Sub IEnumerableAExcel(Of t)(Datos As IEnumerable(Of t), Fichero As String)
Dim wb As New ClosedXML.Excel.XLWorkbook
Dim dt = tsl5.Extensiones.IEnumerableExtensions.CopyToDataTable(Of t)(Datos)
wb.AddWorksheet(dt)
wb.SaveAs(Fichero)
End Sub
Public Shared Sub IEnumerableAExcel(Of t)(Datos As List(Of t), Fichero As String)
Dim wb As New ClosedXML.Excel.XLWorkbook
Dim dt = tsl5.Extensiones.IEnumerableExtensions.CopyToDataTable(Of t)(Datos)
wb.AddWorksheet(dt)
wb.SaveAs(Fichero)
End Sub
Public Shared Function IEnumerableAExcel(Of t)(Datos As List(Of t)) As Byte()
Dim wb As New ClosedXML.Excel.XLWorkbook
Dim dt = tsl5.Extensiones.IEnumerableExtensions.CopyToDataTable(Of t)(Datos)
wb.AddWorksheet(dt)
Dim ms As New MemoryStream
wb.SaveAs(ms)
ms.Position = 0
Return ms.ToArray
End Function
Public Shared Function ListaIEnumerableAExcel(Of t)(Datos As List(Of List(Of t)), NombreTablas As List(Of String)) As Byte()
Dim wb As New ClosedXML.Excel.XLWorkbook
For i = 0 To Datos.Count - 1
Dim tabla = Datos(i)
Dim dt = tsl5.Extensiones.IEnumerableExtensions.CopyToDataTable(Of t)(tabla)
wb.AddWorksheet(dt, NombreTablas(i))
Next
Dim ms As New MemoryStream
wb.SaveAs(ms)
ms.Position = 0
Return ms.ToArray
End Function
End Class
End Namespace

94
Utilidades/odt.vb Normal file
View File

@@ -0,0 +1,94 @@
Imports System.Data.OleDb
Imports MySql.Data.MySqlClient
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 odt
Public Shared Sub ExportarApdf(FicheroOrigen As String, FicheroDestino As String)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(FicheroOrigen, DevExpress.XtraRichEdit.DocumentFormat.OpenDocument)
docServer.Options.Export.Html.EmbedImages = True
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 Function ExportarApdf(FicheroOrigen As String) As Byte()
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(FicheroOrigen, DevExpress.XtraRichEdit.DocumentFormat.OpenDocument)
docServer.Options.Export.Html.EmbedImages = True
Dim po As New PdfExportOptions
po.Compressed = True
Dim ms As New IO.MemoryStream
docServer.ExportToPdf(ms, po)
If ms.CanSeek Then ms.Seek(0, 0)
Dim b = ms.ToArray
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Return b
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
Public Shared Sub ExportarApdf(Documento As IO.Stream, Destino As IO.Stream)
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(Documento, DevExpress.XtraRichEdit.DocumentFormat.OpenDocument)
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 ExportarApdf(Documento As IO.Stream) As Byte()
Try
Dim docServer As New RichEditDocumentServer
docServer.LoadDocument(Documento, DevExpress.XtraRichEdit.DocumentFormat.OpenDocument)
docServer.Options.Export.Html.EmbedImages = True
Dim po As New PdfExportOptions
po.Compressed = True
'po.PageRange = "1-10"
Dim ms As New IO.MemoryStream
docServer.ExportToPdf(ms, po)
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Return ms.ToArray
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
End Class
End Namespace