- Se traslada versión a git desde tfs

This commit is contained in:
2025-05-30 12:06:37 +02:00
commit b93d857a6f
103 changed files with 86476 additions and 0 deletions

152
Utilidades/Docx.vb Normal file
View File

@@ -0,0 +1,152 @@
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, 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) = tsUtilidades.Utilidades.ObtieneFicheroAleatorio("docx")
' sp(i) = tsUtilidades.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
' msPdfUnidos = tsUtilsPDF.pdf.UnePdfsITS(sp)
' Return msPdfUnidos.ToArray
' Else
' Dim sdocx As String
' Do
' sdocx = tsUtilidades.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) ' tsUtilidades.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 DataTable, 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 fs As New IO.FileStream(FicheroDestino, IO.FileMode.Create, IO.FileAccess.Write)
docServer.ExportToPdf(fs)
fs.Close()
docServer.Dispose()
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
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

218
Utilidades/Utilidades.vb Normal file
View File

@@ -0,0 +1,218 @@
Imports DevExpress.Xpf.LayoutControl
Imports System.Data
Imports System.Globalization
Imports System.IO
Imports System.Reflection
Imports bdGestionAntifraude.db
Namespace Utilidades
Public Class Varias
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) OrElse 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 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 &= " OrElse " & 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 &= " OrElse " & 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 &= " OrElse " & c & "=" & Chr(34) & palabra & Chr(34)
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(4) & ")"
Expresion &= " OrElse " & 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 &= " OrElse " & ExpresionParcial
End If
If Expresion <> "" Then
Return Expresion.Substring(8)
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 &= " orelse " & 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 &= " orelse " & 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 &= " orelse " & 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 &= " orelse " & c & "=" & "@" & ContNum.ToString
ReDim Preserve Parametros(ContNum)
Parametros(ContNum) = palabra
ContNum += 1
Next
End If
Next
ExpresionParcial = "(" & ExpresionParcial.Substring(4) & ")"
Expresion &= " orelse " & 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 &= " orelse " & ExpresionParcial
End If
If Expresion <> "" Then
Return Expresion.Substring(8)
Else
Return ""
End If
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 = tsUtilidades.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 = tsUtilidades.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 = tsUtilidades.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 = tsUtilidades.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

83
Utilidades/odt.vb Normal file
View File

@@ -0,0 +1,83 @@

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 ms As New IO.MemoryStream
docServer.Dispose()
GC.Collect()
GC.WaitForPendingFinalizers()
Return ms.ToArray
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

109
Utilidades/tsXtraReports.vb Normal file
View File

@@ -0,0 +1,109 @@
Imports System.IO
Public Class tsXtraReport
Public Shared Sub ExportarAPDF(Plantilla() As Byte, Datos As Object, FicheroPDF As String)
Dim xr As DevExpress.XtraReports.UI.XtraReport
Dim s As String = System.Text.Encoding.UTF8.GetString(Plantilla)
Using sw As New StreamWriter(New MemoryStream())
sw.Write(s)
sw.Flush()
xr = DevExpress.XtraReports.UI.XtraReport.FromStream(sw.BaseStream, True)
End Using
Try
Dim pr As Global.DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First
pr.Value = Now
pr.Visible = False
Catch ex As Exception
End Try
xr.DataSource = Datos
xr.CreateDocument()
xr.ExportToPdf(FicheroPDF)
End Sub
Public Shared Sub ExportarAxls(Plantilla() As Byte, Datos As Object, Ficheroxls As String)
Dim xr As DevExpress.XtraReports.UI.XtraReport
Dim s As String = System.Text.Encoding.UTF8.GetString(Plantilla)
Using sw As New StreamWriter(New MemoryStream())
sw.Write(s)
sw.Flush()
xr = DevExpress.XtraReports.UI.XtraReport.FromStream(sw.BaseStream, True)
End Using
Try
Dim pr As Global.DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First
pr.Value = Now
pr.Visible = False
Catch ex As Exception
End Try
xr.DataSource = Datos
xr.CreateDocument()
xr.ExportToXls(Ficheroxls)
End Sub
Public Shared Sub ExportarAxlsx(Plantilla() As Byte, Datos As Object, Ficheroxlsx As String)
Dim xr As DevExpress.XtraReports.UI.XtraReport
Dim s As String = System.Text.Encoding.UTF8.GetString(Plantilla)
Using sw As New StreamWriter(New MemoryStream())
sw.Write(s)
sw.Flush()
xr = DevExpress.XtraReports.UI.XtraReport.FromStream(sw.BaseStream, True)
End Using
Try
Dim pr As Global.DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First
pr.Value = Now
pr.Visible = False
Catch ex As Exception
End Try
xr.DataSource = Datos
xr.CreateDocument()
xr.ExportToXlsx(Ficheroxlsx)
End Sub
Public Shared Sub ExportarAcsv(Plantilla() As Byte, Datos As Object, Ficherocsv As String)
Dim xr As DevExpress.XtraReports.UI.XtraReport
Dim s As String = System.Text.Encoding.UTF8.GetString(Plantilla)
Using sw As New StreamWriter(New MemoryStream())
sw.Write(s)
sw.Flush()
xr = DevExpress.XtraReports.UI.XtraReport.FromStream(sw.BaseStream, True)
End Using
Try
Dim pr As Global.DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First
pr.Value = Now
pr.Visible = False
Catch ex As Exception
End Try
xr.DataSource = Datos
xr.CreateDocument()
xr.ExportToCsv(Ficherocsv)
End Sub
Public Shared Function ExportarAPDF(Plantilla() As Byte, Datos As Object) As MemoryStream
Dim xr As DevExpress.XtraReports.UI.XtraReport
Dim s As String = System.Text.Encoding.UTF8.GetString(Plantilla)
Using sw As New StreamWriter(New MemoryStream())
sw.Write(s)
sw.Flush()
xr = DevExpress.XtraReports.UI.XtraReport.FromStream(sw.BaseStream, True)
End Using
Try
Dim pr As Global.DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First
pr.Value = Now
pr.Visible = False
Catch ex As Exception
End Try
xr.DataSource = Datos
xr.CreateDocument()
Dim ms As New MemoryStream
xr.ExportToPdf(ms)
Return ms
End Function
End Class