Versión Copiada del tfs

This commit is contained in:
2025-05-29 17:58:18 +02:00
commit 857f247df5
69 changed files with 22831 additions and 0 deletions

View File

@@ -0,0 +1,64 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module BinaryReaderExtensions
<Extension()>
Public Function ReadAllBytes(ByVal reader As IO.BinaryReader) As Byte()
Const bufferSize As Integer = 4095
Using ms = New IO.MemoryStream()
Dim buffer As Byte() = New Byte(bufferSize) {}
Dim count As Integer
Dim bFinish As Boolean = False
Do Until bFinish
count = reader.Read(buffer, 0, buffer.Length)
If count = 0 Then
bFinish = True
Else
ms.Write(buffer, 0, count)
End If
Loop
'While (count = reader.Read(buffer, 0, buffer.Length)) <> 0
' ms.Write(buffer, 0, count)
'End While
Return ms.ToArray()
End Using
End Function
End Module
Public Class LineReader
Inherits IO.BinaryReader
Public Sub New(ByVal stream As IO.Stream, ByVal encoding As Text.Encoding)
MyBase.New(stream, encoding)
End Sub
Public currentPos As Integer
Private stringBuffer As Text.StringBuilder
Public Function ReadLine() As String
currentPos = 0
Dim buf As Char() = New Char(0) {}
stringBuffer = New Text.StringBuilder()
Dim lineEndFound As Boolean = False
While MyBase.Read(buf, 0, 1) > 0
currentPos += 1
If buf(0) = Microsoft.VisualBasic.Strings.ChrW(10) Then
lineEndFound = True
Else
stringBuffer.Append(buf(0))
End If
If lineEndFound Then
Return stringBuffer.ToString()
End If
End While
Return stringBuffer.ToString()
End Function
End Class
End Namespace

View File

@@ -0,0 +1,65 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DateOnlyExtensions
<Extension()>
Public Function Minimo(Fecha1 As Nullable(Of DateOnly), Fecha2 As Nullable(Of DateOnly)) As Nullable(Of DateOnly)
Dim t1, t2 As DateOnly
If Fecha1.HasValue Then t1 = Fecha1.Value
If Fecha2.HasValue Then t2 = Fecha2.Value
If t1 < t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function Maximo(Fecha1 As Nullable(Of DateOnly), Fecha2 As Nullable(Of DateOnly)) As Nullable(Of DateOnly)
Dim t1, t2 As DateOnly
If Fecha1.HasValue Then t1 = Fecha1.Value
If Fecha2.HasValue Then t2 = Fecha2.Value
If t1 > t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function ValorNumerico(Fecha As Nullable(Of DateOnly)) As Long
If Fecha Is Nothing Then
Return 0
Else
Return Fecha.Value.Year * 10000 + Fecha.Value.Month * 100 + Fecha.Value.Day
End If
End Function
<Extension()>
Public Function ToDateTime(Fecha As Nullable(Of DateOnly)) As DateTime
If Fecha Is Nothing Then
Return Nothing
Else
Return New DateTime(Fecha.Value.Year, Fecha.Value.Month, Fecha.Value.Day)
End If
End Function
<Extension()>
Public Function ToDateTime(Fecha As DateOnly) As DateTime
Return New DateTime(Fecha.Year, Fecha.Month, Fecha.Day)
End Function
<Extension()>
Public Function ToDate(Fecha As Nullable(Of DateOnly)) As DateTime
If Fecha Is Nothing Then
Return Nothing
Else
Return New Date(Fecha.Value.Year, Fecha.Value.Month, Fecha.Value.Day)
End If
End Function
<Extension()>
Public Function ToDate(Fecha As DateOnly) As DateTime
Return New Date(Fecha.Year, Fecha.Month, Fecha.Day)
End Function
End Module
End Namespace

View File

@@ -0,0 +1,152 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DateTimeExtensions
<Extension()>
Public Function FechaNulableAString(Fecha As Date?) As String
If Fecha Is Nothing Then
Return ""
Else
Return Fecha.Value.ToString("dd/MM/yyyy")
End If
End Function
<Extension()>
Public Function FechaHoraStringADate(Fecha As String, Optional SinSegundos As Boolean = False) As DateTime?
Dim dt As New DateTime
If Fecha = "0" Then
Return Nothing
Else
If Fecha.Contains("_") Then
Dim s() As String = Fecha.Split("_")
dt = New DateTime(s(0), s(1), s(2), s(3), s(4), s(5))
Else
If Fecha.Contains(".") And (Fecha.Length = 13 OrElse Fecha.Length = 12) Then
Fecha = Fecha.Split(".")(0) & Fecha.Split(".")(1).Substring(0, 2) & Math.Round(Double.Parse(Fecha.Split(".")(1).Substring(2)) * 60 / 100, 0, MidpointRounding.AwayFromZero).ToString.PadLeft(2, "0") & "00"
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(4, 2), Fecha.Substring(6, 2), Fecha.Substring(8, 2), Fecha.Substring(10, 2), Fecha.Substring(12, 2))
Else
If Fecha.Length = 14 Then
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(4, 2), Fecha.Substring(6, 2), Fecha.Substring(8, 2), Fecha.Substring(10, 2), Fecha.Substring(12, 2))
Else
If Fecha.Length = 19 Then
dt = New DateTime(Fecha.Substring(0, 4), Fecha.Substring(5, 2), Fecha.Substring(8, 2), Fecha.Substring(11, 2), Fecha.Substring(14, 2), Fecha.Substring(17, 2))
Else
If Fecha.Length = 6 Then Fecha = "19" & Fecha
If Fecha.Contains(".") Then
Dim horas = Double.Parse(Fecha.Split(".")(1).PadRight(6, "0")) / 10000
Dim Segundos = horas * 60 * 60
Dim ts = TimeSpan.FromSeconds(Segundos)
dt = New DateTime(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
dt = dt + ts
Else
dt = New Date(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
End If
End If
End If
End If
End If
If SinSegundos Then dt = New Date(dt.Year, dt.Month, dt.Day, dt.Hour, dt.Minute, 0)
Return dt
End If
End Function
<Extension()>
Public Function Maximo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As Nullable(Of DateTime)
Dim t1, t2 As Long
If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
If t1 > t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function Minimo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As Nullable(Of DateTime)
Dim t1, t2 As Long
If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
If t1 < t2 Then
Return Fecha1
Else
Return Fecha2
End If
End Function
<Extension()>
Public Function MesCastellano(Fecha As Date) As String
Select Case Fecha.Month
Case 1
Return "Enero"
Case 2
Return "Febrero"
Case 3
Return "Marzo"
Case 4
Return "Abril"
Case 5
Return "Mayo"
Case 6
Return "Junio"
Case 7
Return "Julio"
Case 8
Return "Agosto"
Case 9
Return "Septiembre"
Case 10
Return "Octubre"
Case 11
Return "Noviembre"
Case Else
Return "Diciembre"
End Select
End Function
<Extension>
Public Function ValorNumerico(Fecha As Date) As Long
Return Fecha.Year * 10000 + Fecha.Month * 100 + Fecha.Day
End Function
<Extension>
Public Function ValorNumerico(Fecha As Nullable(Of Date)) As Long
If Fecha Is Nothing Then
Return 0
Else
Return Fecha.Value.Year * 10000 + Fecha.Value.Month * 100 + Fecha.Value.Day
End If
End Function
'Public Function Maximo(Fecha1 As DateTime, Fecha2 As DateTime) As DateTime
' Dim t1, t2 As Long
' If Fecha1 Is Nothing Then t1 = Fecha1.Ticks
' If Not Fecha2 Is Nothing Then t2 = Fecha2.Ticks
' If t1 > t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
'Public Function Minimo(Fecha1 As Nullable(Of DateTime), Fecha2 As Nullable(Of DateTime)) As DateTime
' Dim t1, t2 As Long
' If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
' If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
' If t1 < t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
'Public Function Maximo(Fecha1 As Nullable(Of Date), Fecha2 As Nullable(Of Date)) As Date
' Dim t1, t2 As Long
' If Fecha1.HasValue Then t1 = Fecha1.Value.Ticks
' If Fecha2.HasValue Then t2 = Fecha2.Value.Ticks
' If t1 > t2 Then
' Return Fecha1
' Else
' Return Fecha2
' End If
'End Function
End Module
End Namespace

View File

@@ -0,0 +1,104 @@
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports Microsoft.EntityFrameworkCore
Imports Microsoft.EntityFrameworkCore.Internal
Imports System.Linq.Dynamic.Core
Namespace Extensiones
Public Module DbContextExtensions
<Extension()>
Public Function Query(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal entityName As String) As IQueryable
Return context.Query(context.Model.FindEntityType(entityName).ClrType)
End Function
<Extension()>
Public Function Query(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal entityType As Type) As IQueryable
Return CType((CType(context, IDbSetCache)).GetOrAddSet(context.GetDependencies().SetSource, entityType), IQueryable)
End Function
<Extension()>
Public Function ObtieneCampoIndice(ByVal context As Microsoft.EntityFrameworkCore.DbContext, ByVal Entidad As Object) As String
Dim entry = context.Entry(Entidad)
Dim pk = entry.Metadata.FindPrimaryKey()
Return pk.Properties.FirstOrDefault()?.Name
End Function
<Extension()>
Public Function ObtieneMaximaLongitudCampo(bd As Microsoft.EntityFrameworkCore.DbContext, ByVal EspacioNombres As String, ByVal NombreTablaBase As String, ByVal NombreCampo As String) As Integer
Try
If Not NombreCampo.Contains(".") Then
Dim Tabla = bd.Model.FindEntityType(EspacioNombres & "." & NombreTablaBase)
If Tabla Is Nothing Then Throw New Exception("Tabla " & NombreTablaBase & " no encontrada")
Dim Campo = Tabla.FindProperty(NombreCampo)
If Campo Is Nothing Then
Return -1 ' Throw New Exception("No existe el campo " & NombreCampo & " en la tabla " & NombreTablaBase)
Else
Dim LongitudCampo As Integer? = Campo.GetMaxLength()
If LongitudCampo.HasValue Then
Return LongitudCampo.Value
Else
Return -1
End If
End If
Else
Return -1
End If
Catch ex As Exception
Throw New Exception(ex.Message, ex)
End Try
End Function
<Extension()>
Public Function ExecSQL(Of T)(dbc As Microsoft.EntityFrameworkCore.DbContext, ByVal query As String) As List(Of T)
Dim Command = dbc.Database.GetDbConnection().CreateCommand()
Command.CommandText = query
Command.CommandType = Data.CommandType.Text
dbc.Database.OpenConnection()
Dim list As List(Of T) = New List(Of T)()
Dim result = Command.ExecuteReader()
Dim obj As T = Nothing
While result.Read()
obj = Activator.CreateInstance(Of T)()
For Each prop As PropertyInfo In obj.[GetType]().GetProperties()
If Not Object.Equals(result(prop.Name), DBNull.Value) Then
prop.SetValue(obj, result(prop.Name), Nothing)
End If
Next
list.Add(obj)
End While
dbc.Database.CloseConnection()
Return list
End Function
<Extension()>
Public Function CompruebaRegistroUnico(bd As Microsoft.EntityFrameworkCore.DbContext, CompruebaIndice As Boolean, EspacioNombres As String, NombreTabla As String, NombreCampo As String, Valor As Object, Entidad As Object) As Boolean
Dim Busqueda As String = NombreCampo & "==""" & CStr(Valor) & """"
If CompruebaIndice Then
Dim CampoIndice As String = bd.ObtieneCampoIndice(Entidad)
Dim ValorCampoIndice As String = CStr(bd.Entry(Entidad).[Property](CampoIndice).CurrentValue.ToString())
Busqueda += " && " & CampoIndice & "!=" & ValorCampoIndice
End If
Dim resp As Boolean = bd.Query(EspacioNombres & "." & NombreTabla).Any(Busqueda)
Return Not resp
End Function
<Extension()>
Public Function AhoraMySql(ByVal context As Microsoft.EntityFrameworkCore.DbContext) As DateTime
Dim cn = context.Database.GetDbConnection
Dim cmd = cn.CreateCommand
cmd.CommandText = "select now() as Ahora"
cn.Open()
Dim Hora As DateTime = cmd.ExecuteScalar
cn.Close()
Return Hora
End Function
End Module
End Namespace

View File

@@ -0,0 +1,27 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module DoubleExtensions
<Extension()> Function APalabras(Numero As Double) As String
Return NumerosAPalabras.ToCardinal(Numero)
End Function
<Extension()> Function AEurosEnLetras(Numero As Double) As String
Dim EnteroDecimal As Int32 = Int(Math.Round((Numero - Int(Numero)) * Math.Pow(10, 2)))
If EnteroDecimal > 0 Then
Dim convertidor As New NumerosAPalabras(True, "", "Euros con", True)
Return convertidor.ToCustomCardinal(Numero).Trim & " céntimos"
Else
Return NumerosAPalabras.ToCardinal(Numero).Trim & " Euros"
End If
End Function
<Extension()> Function EntreValores(Valor As Double, RangoMenor As Double, RangoMayor As Double) As Boolean
Return Valor >= RangoMenor And Valor <= RangoMayor
End Function
<Extension()> Function NothingA0(Valor As Double?) As Double
Dim Doble = If(Valor.HasValue, Valor.Value, 0)
Return Doble
End Function
End Module
End Namespace

150
Extensiones/IEnumerable.vb Normal file
View File

@@ -0,0 +1,150 @@
Imports System.Runtime.CompilerServices
Imports System.Reflection
Imports System.Data
Namespace Extensiones
Public Module IEnumerableExtensions
<Extension()>
Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T)) As DataTable
Return New ObjectShredder(Of T)().Shred(source, Nothing, Nothing)
End Function
<Extension()>
Public Function CopyToDataTable(Of T)(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
Return New ObjectShredder(Of T)().Shred(source, table, options)
End Function
End Module
End Namespace
Public Class ObjectShredder(Of T)
Private _fi As FieldInfo()
Private _pi As PropertyInfo()
Private _ordinalMap As Dictionary(Of String, Integer)
Private _type As Type
Public Sub New()
_type = GetType(T)
_fi = _type.GetFields()
_pi = _type.GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse x.PropertyType.BaseType.Name = "EntityObject")).ToArray
_ordinalMap = New Dictionary(Of String, Integer)()
End Sub
Public Function Shred(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
If GetType(T).IsPrimitive Then
Return ShredPrimitive(source, table, options)
End If
If table Is Nothing Then
table = New DataTable(GetType(T).Name)
End If
table = ExtendTable(table, GetType(T))
table.BeginLoadData()
Using e As IEnumerator(Of T) = source.GetEnumerator()
While e.MoveNext()
If options IsNot Nothing Then
table.LoadDataRow(ShredObject(table, e.Current), CType(options, LoadOption))
Else
table.LoadDataRow(ShredObject(table, e.Current), True)
End If
End While
End Using
table.EndLoadData()
Return table
End Function
Public Function ShredPrimitive(ByVal source As IEnumerable(Of T), ByVal table As DataTable, ByVal options As LoadOption?) As DataTable
If table Is Nothing Then
table = New DataTable(GetType(T).Name)
End If
If Not table.Columns.Contains("Value") Then
table.Columns.Add("Value", GetType(T))
End If
table.BeginLoadData()
Using e As IEnumerator(Of T) = source.GetEnumerator()
Dim values As Object() = New Object(table.Columns.Count - 1) {}
While e.MoveNext()
values(table.Columns("Value").Ordinal) = e.Current
If options IsNot Nothing Then
table.LoadDataRow(values, CType(options, LoadOption))
Else
table.LoadDataRow(values, True)
End If
End While
End Using
table.EndLoadData()
Return table
End Function
Public Function ExtendTable(ByVal table As DataTable, ByVal type As Type) As DataTable
For Each f As FieldInfo In type.GetFields()
If Not _ordinalMap.ContainsKey(f.Name) Then
Dim dc As DataColumn = If(table.Columns.Contains(f.Name), table.Columns(f.Name), table.Columns.Add(f.Name, f.FieldType))
_ordinalMap.Add(f.Name, dc.Ordinal)
End If
Next
Dim Propiedades = type.GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse x.PropertyType.BaseType.Name = "EntityObject"))
For Each p As PropertyInfo In Propiedades
If Not _ordinalMap.ContainsKey(p.Name) Then
Dim propiedad = p.PropertyType
If propiedad Is GetType(Integer?) Then
propiedad = GetType(Integer)
ElseIf propiedad Is GetType(Double?) Then
propiedad = GetType(Double)
ElseIf propiedad Is GetType(Long?) Then
propiedad = GetType(Long)
ElseIf propiedad Is GetType(Boolean?) Then
propiedad = GetType(Boolean)
ElseIf propiedad Is GetType(DateTime?) Then
propiedad = GetType(DateTime)
ElseIf propiedad Is GetType(Date?) Then
propiedad = GetType(Date)
End If
Dim dc As DataColumn = If(table.Columns.Contains(p.Name), table.Columns(p.Name), table.Columns.Add(p.Name, propiedad))
_ordinalMap.Add(p.Name, dc.Ordinal)
End If
Next
Return table
End Function
Public Function ShredObject(ByVal table As DataTable, ByVal instance As T) As Object()
Dim fi As FieldInfo() = _fi
Dim pi As PropertyInfo() = _pi
If instance.[GetType]() <> GetType(T) Then
ExtendTable(table, instance.[GetType]())
fi = instance.[GetType]().GetFields()
pi = instance.[GetType]().GetProperties.Where(Function(x) Not (x.PropertyType.Name.Contains("EntityReference") OrElse x.PropertyType.Name.Contains("EntityCollection") OrElse x.PropertyType.Name.Contains("EntityState") OrElse x.PropertyType.Name.Contains("EntityKey") OrElse x.PropertyType.BaseType.Name = "EntityObject")).ToArray
End If
Dim values As Object() = New Object(table.Columns.Count - 1) {}
For Each f As FieldInfo In fi
values(_ordinalMap(f.Name)) = f.GetValue(instance)
Next
For Each p As PropertyInfo In pi
values(_ordinalMap(p.Name)) = p.GetValue(instance, Nothing)
Next
Return values
End Function
End Class

View File

@@ -0,0 +1,13 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module IntegerExtensions
<Extension()> Function APalabras(Numero As Integer) As String
Return NumerosAPalabras.ToCardinal(Numero)
End Function
<Extension()> Function EntreValores(Valor As Integer, RangoMenor As Integer, RangoMayor As Integer) As Boolean
Return Valor >= RangoMenor And Valor <= RangoMayor
End Function
End Module
End Namespace

View File

@@ -0,0 +1,16 @@
Imports System.Runtime.CompilerServices
Namespace Extensiones
Public Module NameValueCollection
<Extension()>
Public Function ToPairs(collection As Specialized.NameValueCollection) As IEnumerable(Of KeyValuePair(Of String, String))
If collection Is Nothing Then
Throw New ArgumentNullException("collection")
End If
Return collection.Cast(Of String)().[Select](Function(key) New KeyValuePair(Of String, String)(key, collection(key)))
End Function
End Module
End Namespace

View File

@@ -0,0 +1,72 @@
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Imports Microsoft.EntityFrameworkCore
Imports System.Data.Entity.Core.Objects
Imports System.Data.Entity.Core
Imports System.Reflection
Imports Microsoft.EntityFrameworkCore.Infrastructure
Imports Newtonsoft.Json
Imports System.Formats
'Imports System.Data.Entity.Core.Objects
'Imports System.Data.Entity.Core.Objects
Namespace Extensiones
Public Module ObjetExtensions
<Extension>
Public Function ObjetoNothingAVacio(ByVal Cadena As Object) As String
If Cadena Is Nothing Then
Return ""
Else
Return Cadena.ToString
End If
End Function
'<Extension>
'Public Function GetDbContextFromEntity(ByVal entity As Object) As Data.Entity.DbContext
' Dim object_context = GetObjectContextFromEntity(entity)
' If object_context Is Nothing OrElse object_context.TransactionHandler Is Nothing Then Return Nothing
' Return object_context.TransactionHandler.DbContext
'End Function
'Private Function GetObjectContextFromEntity(ByVal entity As Object) As ObjectContext
' Dim field = entity.[GetType]().GetField("_entityWrapper")
' If field Is Nothing Then Return Nothing
' Dim wrapper = field.GetValue(entity)
' Dim [property] = wrapper.[GetType]().GetProperty("Context")
' Dim context = CType([property].GetValue(wrapper, Nothing), ObjectContext)
' Return context
'End Function
'<Extension>
'Public Function ObtieneContexto(entity As Objects.DataClasses.EntityObject) As Objects.ObjectContext
' Dim relationshipManager = DirectCast(entity, Objects.DataClasses.IEntityWithRelationships).RelationshipManager
' Dim wrappedOwnerProperty = relationshipManager.GetType.GetProperty("WrappedOwner", Reflection.BindingFlags.Instance Or BindingFlags.NonPublic)
' Return wrappedOwnerProperty.GetValue(relationshipManager).Context
'End Function
<Extension()>
Function GetDbContext(Of T As Class)(ByVal dbSet As DbSet(Of T)) As DbContext
Dim infrastructure = TryCast(dbSet, IInfrastructure(Of IServiceProvider))
Dim serviceProvider = infrastructure.Instance
Dim currentDbContext = TryCast(serviceProvider.GetService(GetType(ICurrentDbContext)), ICurrentDbContext)
Return currentDbContext.Context
End Function
<Extension()>
Function Clonar(Of T)(ByVal self As T) As T
Dim serialized = JsonConvert.SerializeObject(self)
Return JsonConvert.DeserializeObject(Of T)(serialized)
End Function
<Extension()>
Sub CopiarPropiedadesDe(Of T)(ByVal Destino As T, ByVal Origen As T)
Dim props = Destino.GetType.GetProperties.Where(Function(x) x.CanWrite).ToList
For Each p In props
p.SetValue(Destino, Origen.GetType.GetProperty(p.Name).GetValue(Origen))
Next
End Sub
'<Extension()>
'Function ObtieneContexto(Of T As Class)(ByVal Objeto As T) As DbContext
' Dim infrastructure = TryCast(Objeto, IInfrastructure(Of IServiceProvider))
' Dim serviceProvider = infrastructure.Instance
' Dim currentDbContext = TryCast(serviceProvider.GetService(GetType(ICurrentDbContext)), ICurrentDbContext)
' Return currentDbContext.Context
'End Function
End Module
End Namespace

View File

@@ -0,0 +1,65 @@
Imports System.Collections.Generic
Imports System.Text
Imports System.Xml.Serialization
Namespace Extensiones
<XmlRoot("dictionary")> _
Public Class SerializableDictionary(Of TKey, TValue)
Inherits Dictionary(Of TKey, TValue)
Implements IXmlSerializable
#Region "IXmlSerializable Members"
Public Function GetSchema() As System.Xml.Schema.XmlSchema Implements IXmlSerializable.GetSchema
Return Nothing
End Function
Public Sub ReadXml(reader As System.Xml.XmlReader) Implements IXmlSerializable.ReadXml
Dim keySerializer As New XmlSerializer(GetType(TKey))
Dim valueSerializer As New XmlSerializer(GetType(TValue))
Dim wasEmpty As Boolean = reader.IsEmptyElement
reader.Read()
If wasEmpty Then
Return
End If
While reader.NodeType <> System.Xml.XmlNodeType.EndElement
reader.ReadStartElement("item")
reader.ReadStartElement("key")
Dim key As TKey = DirectCast(keySerializer.Deserialize(reader), TKey)
reader.ReadEndElement()
reader.ReadStartElement("value")
Dim value As TValue = DirectCast(valueSerializer.Deserialize(reader), TValue)
reader.ReadEndElement()
Me.Add(key, value)
reader.ReadEndElement()
reader.MoveToContent()
End While
reader.ReadEndElement()
End Sub
Public Sub WriteXml(writer As System.Xml.XmlWriter) Implements IXmlSerializable.WriteXml
Dim keySerializer As New XmlSerializer(GetType(TKey))
Dim valueSerializer As New XmlSerializer(GetType(TValue))
For Each key As TKey In Me.Keys
writer.WriteStartElement("item")
writer.WriteStartElement("key")
keySerializer.Serialize(writer, key)
writer.WriteEndElement()
writer.WriteStartElement("value")
Dim value As TValue = Me(key)
valueSerializer.Serialize(writer, value)
writer.WriteEndElement()
writer.WriteEndElement()
Next
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,715 @@
Option Strict Off
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Imports System.Text.RegularExpressions
Imports tsUtilidades.ValidarDocumentoIdentidad
Imports System.Globalization
Imports System.Text
Namespace codificacion
Public Class Caracteres
Public Shared juegos()() As Char = New Char()() {"ñѺªçÇáéíóúÁÉÍÓÚàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛäëïöüÄËÏÖÜ", "·¶úùµ´ÄÅÕÆÇàÜåçíÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ", "·¶úùµ´aeiouAEIOUÈÉÙÊË¡£æè­ÀÁÑÂ⤦߮ÌÍÝÎÏØ¥§ÚÛ"}
Public Enum JuegoCaracteres
WINDOWS = 0
ROMAN8 = 1
ROMAN8_SIN_ACENTOS = 2
End Enum
End Class
End Namespace
Namespace Extensiones
Public Module StringExtensions
<Extension()>
Public Function EsDNIValido(ByVal DNI As String) As Boolean
Try
Dim v As New ValidarDocumentoIdentidad(DNI)
Return v.EsCorrecto
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function TipoDocumentoIdentidad(ByVal DNI As String) As TiposDocumentosEnum
Try
Dim v As New ValidarDocumentoIdentidad(DNI)
Return v.TipoDocumento
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsEmailValido(ByVal email As String) As Boolean
Try
email = email.NothingAVacio.Trim.ToLower
Dim addr = New System.Net.Mail.MailAddress(email)
Return addr.Address = email
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsListaEmailsValida(ByVal Listaemail As String) As Boolean
Try
If Listaemail.NothingAVacio = "" Then
Return False
Else
Dim emails = Listaemail.Split(";")
For Each email In emails
email = email.NothingAVacio.Trim.ToLower
If email <> "" Then
Dim addr = New System.Net.Mail.MailAddress(email)
If addr.Address <> email Then
Throw New Exception("Email incorrecto")
End If
End If
Next
Return True
End If
Catch ex As Exception
Return False
End Try
End Function
<Extension()>
Public Function EsNumeroTelefonoMovilEspañolValido(ByVal Telefono As String) As Boolean
Telefono = Telefono.NothingAVacio.Trim
Dim Valido As Boolean = True
If Telefono.Length = 9 Then
If Not (Telefono.StartsWith("6") OrElse Telefono.StartsWith("7")) Then
Valido = False
End If
ElseIf Telefono.Length = 11 Then
If Not Telefono.StartsWith("34") Then
Valido = False
End If
ElseIf Telefono.Length = 12 Then
If Not Telefono.StartsWith("+34") Then
Valido = False
End If
Else
Valido = False
End If
If Valido Then
For i = 1 To Telefono.Length - 1
If Not "1234567890".Contains(Telefono.Substring(i, 1)) Then
Valido = False
Exit For
End If
Next
End If
Return Valido
End Function
<Extension()>
Public Function EsNumeroTelefonoEspañolValido(ByVal Telefono As String) As Boolean
Telefono = Telefono.NothingAVacio.Trim
Dim Valido As Boolean = True
If Telefono.Length = 9 Then
If Not (Telefono.StartsWith("6") OrElse Telefono.StartsWith("7") OrElse Telefono.StartsWith("8") OrElse Telefono.StartsWith("9")) Then
Valido = False
End If
ElseIf Telefono.Length = 11 Then
If Not Telefono.StartsWith("34") Then
Valido = False
End If
ElseIf Telefono.Length = 12 Then
If Not Telefono.StartsWith("+34") Then
Valido = False
End If
Else
Valido = False
End If
If Valido Then
For i = 1 To Telefono.Length - 1
If Not "1234567890".Contains(Telefono.Substring(i, 1)) Then
Valido = False
Exit For
End If
Next
End If
Return Valido
End Function
<Extension()>
Public Function HoraDecimalASexagesimal(ByVal Cadena As String) As String
If Cadena.Contains(".") Then
Dim ParteDecimal = CInt(Cadena.Split(".")(1).PadRight(2, "0").Substring(0, 2))
Dim Minutos = Math.Min(59, Math.Round(ParteDecimal * 60 / 100, 0, MidpointRounding.AwayFromZero))
Return Cadena.Split(".")(0).PadLeft(2, "0") & ":" & Minutos.ToString.PadLeft(2, "0")
Else
Return Cadena.PadLeft(2, "0") & ":00"
End If
End Function
<Extension()>
Public Function HoraStringATimeSpan(ByVal Cadena As String) As TimeSpan
Dim TS As TimeSpan
If Cadena = "00:00" Then
TS = New TimeSpan(0)
Else
Dim HoraEntera As String = Cadena
If Cadena.StartsWith("-") Then HoraEntera = Cadena.Substring(1)
If HoraEntera.Split(":").Length = 3 Then
TS = New TimeSpan(CInt(HoraEntera.Split(":")(0)), CInt(HoraEntera.Split(":")(1)), CInt(HoraEntera.Split(":")(2)))
Else
TS = New TimeSpan(CInt(HoraEntera.Split(":")(0)), CInt(HoraEntera.Split(":")(1)), 0)
End If
If Cadena.StartsWith("-") Then
TS = -TS
End If
End If
Return TS
End Function
<Extension()>
Public Function ATimeSpan(ByVal Cadena As String) As TimeSpan
Dim TS As TimeSpan
If Cadena = "0" Then
TS = New TimeSpan(0)
Else
Dim HoraEntera As String = Cadena
If Cadena.StartsWith("-") Then HoraEntera = Cadena.Substring(1)
If HoraEntera.Contains(".") Then
TS = New TimeSpan(CInt(HoraEntera.Split(".")(0)), (Double.Parse("0." & HoraEntera.Split(".")(1), Globalization.CultureInfo.InvariantCulture) * 60), 0)
Else
TS = New TimeSpan(CInt(HoraEntera.Split(".")(0)), 0, 0)
End If
If Cadena.StartsWith("-") Then
TS = -TS
End If
End If
Return TS
End Function
<Extension()>
Public Function NothingAVacio(ByVal Cadena As String) As String
If Cadena Is Nothing Then
Return ""
Else
Return Cadena
End If
End Function
<Extension()>
Public Sub ImprimirEnConsola(ByVal aString As String)
Console.WriteLine(aString)
End Sub
<Extension()>
Public Sub ImprimirEnConsolaDeDepuracion(ByVal aString As String)
System.Diagnostics.Debug.WriteLine(aString)
End Sub
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena.</remarks>
<Extension()>
Public Function AcortarPorLaIzquierda(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(aString.Length - longitud, longitud).TrimEnd
Else
resultado = aString
End If
Return resultado
End If
End Function
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena.</remarks>
<Extension()>
Public Function Acortar(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud).TrimEnd
Else
resultado = aString
End If
Return resultado
End If
End Function
<Extension()>
Public Function LongitudFija(ByVal aString As String, ByVal longitud As Integer) As String
If aString Is Nothing Then
Return ""
Else
Dim resultado As String
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud)
Else
resultado = aString.PadRight(longitud, " ")
End If
Return resultado
End If
End Function
''' <summary>
''' Acorta la longitud de un String hasta la longitud especificada. Nunca lanza excepciones, aunque no exista el objeto.
''' </summary>
''' <param name="aString"></param>
''' <param name="longitud">La longitud a la que se desea acortar la cadena.</param>
''' <returns></returns>
''' <remarks>Si la cadena es más pequeña que la longitud especificada no lanza excepción. Siempre hace Trim a la cadena. Nunca lanza excepciones, aunque no exista el objeto.</remarks>
<Extension()>
Public Function AcortarSinExcepciones(ByVal aString As String, ByVal longitud As Integer) As String
Dim resultado As String
Try
aString = aString.Trim
If aString.Length >= longitud Then
resultado = aString.Substring(0, longitud).TrimEnd
Else
resultado = aString
End If
Catch ex As Exception
resultado = ""
End Try
Return resultado
End Function
''' <summary>
''' Recorta por el final de la cadena el número de caracteres especificado en "longitud".
''' </summary>
''' <param name="aString">La cadena a manipular.</param>
''' <param name="longitud">El número de caracteres que se desea recortar al final de la cadena.</param>
''' <returns>La cadena original pero con "longitud" caracteres menos al final.</returns>
''' <remarks>Nunca lanza excepciones. Si la cadena es más corta que el número de caracteres que se desea recortar, se devuelve cadena vacía.</remarks>
''' <example>Si "aString" vale "patata" y "longitud" vale "2", el resultado es "pata".</example>
<Extension()>
Public Function RecortarPorElFinal(ByVal aString As String, ByVal longitud As Integer) As String
Dim resultado As String = ""
If aString IsNot Nothing AndAlso aString.Length > longitud Then
resultado = aString.Substring(0, aString.Length - longitud)
End If
Return resultado
End Function
<Extension()>
Public Function ToMySql(d As Date) As String
Return d.ToString("yyyy-MM-dd HH:mm:ss")
End Function
<Extension()>
Public Function ConvierteDeWindowsARoman8(ByVal CadenaAconvertir As String)
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.WINDOWS, codificacion.Caracteres.JuegoCaracteres.ROMAN8)
End Function
<Extension()>
Public Function ConvierteDeWindowsARoman8SinAcentos(ByVal CadenaAconvertir As String)
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.WINDOWS, codificacion.Caracteres.JuegoCaracteres.ROMAN8_SIN_ACENTOS)
End Function
<Extension()>
Public Function ConvierteDeRoman8AWindows(ByVal CadenaAconvertir As String)
Return ConvierteStrings(CadenaAconvertir, codificacion.Caracteres.JuegoCaracteres.ROMAN8, codificacion.Caracteres.JuegoCaracteres.WINDOWS)
End Function
<Extension()>
Public Function ConvierteAAlfanumerico(ByVal StringOrigen As String, Optional cOrigen As String = "ÁÉÍÓÚÜáéíóúü", Optional cDestino As String = "AEIOUUaeiouu", Optional cPermitidos As String = "ABCDEFGHIJKLMNÑOPQRSTUVWXYZabcdefghijklmnñopqrstuvwxyz0123456789,.") As String
Try
Dim iNumChar As Integer, i
iNumChar = StringOrigen.Length - 1
Dim idx As Integer
Dim sDestino As String = ""
For i = 0 To iNumChar
'If cPermitidos.Contains(StringOrigen.Substring(i, 1)) Then
' sDestino &= StringOrigen.Substring(i, 1)
'Else
' If cOrigen.Contains(StringOrigen.Substring(i, 1)) Then
' idx = cOrigen.IndexOf(StringOrigen.Substring(i, 1))
' sDestino &= cDestino.Substring(idx, 1)
' Else
' sDestino &= " "
' End If
'End If
If cOrigen.Contains(StringOrigen.Substring(i, 1)) Then
idx = cOrigen.IndexOf(StringOrigen.Substring(i, 1))
sDestino &= cDestino.Substring(idx, 1)
Else
If cPermitidos.Contains(StringOrigen.Substring(i, 1)) Then
sDestino &= StringOrigen.Substring(i, 1)
Else
sDestino &= " "
End If
End If
Next
Return sDestino
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
Public Function ConvierteStrings(ByVal StringOrigen As String, ByVal jcOrigen As codificacion.Caracteres.JuegoCaracteres, ByVal jcDestino As codificacion.Caracteres.JuegoCaracteres) As String
Try
Dim iNumChar As Integer, i, pos As Integer
Dim cAux(), cOrigen(), cDestino() As Char
cOrigen = codificacion.Caracteres.juegos(jcOrigen)
cDestino = codificacion.Caracteres.juegos(jcDestino)
iNumChar = cOrigen.Length
cAux = StringOrigen
For i = 0 To iNumChar - 1
pos = 0
Do
pos = InStr(pos + 1, StringOrigen, cOrigen(i), CompareMethod.Binary)
If pos > 0 Then
cAux(pos - 1) = cDestino(i)
End If
Loop Until pos = 0
Next
ConvierteStrings = cAux
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
<Extension()>
Public Function FechaHoraStringADateTime(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateTime?
Try
If Fecha = "0" OrElse Fecha = "0.0000" Then
Return Nothing
Else
If Fecha.Length > 16 AndAlso Fecha.Substring(11, 1) = "/" Then
Dim f As Date = FechaStringADate(Fecha.Substring(0, 11), True)
Dim sHora = Fecha.Substring(12).Split(":")
Dim Hora As Integer = CInt(sHora(0))
Dim Minutos As Integer = CInt(sHora(1))
Dim Segundos As Integer = 0
If sHora.Length > 2 Then
Segundos = CInt(sHora(2))
End If
Return New DateTime(f.Year, f.Month, f.Day, Hora, Minutos, Segundos)
Else
If Fecha.Contains(".") Then
Dim HoraMinutos = CInt(Fecha.Split(".")(1).PadRight(4, "0"))
Dim Minuto = (HoraMinutos Mod 100) / 100 * 60
Dim Hora = Math.Truncate(HoraMinutos / 100)
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), Hora, Minuto, 0)
Else
Return New Date(CInt(Fecha.Substring(0, 4)), CInt(Fecha.Substring(4, 2)), CInt(Fecha.Substring(6, 2)), 0, 0, 0)
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw ex
End If
End Try
End Function
<Extension()>
Public Function FechaStringADateTime(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateTime?
Try
If Fecha = "0" Then
Return Nothing
Else
Dim cSeparador As String = ""
If Fecha.Contains("de") Then
Fecha = Fecha.Replace(" de ", "-")
End If
If Fecha.Contains("-") Then cSeparador = "-"
If Fecha.Contains("/") Then cSeparador = "/"
If Fecha.Contains(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New DateTime(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
'Throw New Exception("formato de fecha no soportado")
Else
Dim mFecha() As String
mFecha = Fecha.Split(cSeparador)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New DateTime(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New DateTime(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw New Exception(ex.Message, ex)
End If
End Try
End Function
<Extension()>
Public Function FechaStringADate(Fecha As String, Optional NuloSiInvalido As Boolean = True) As Date?
Try
If Fecha = "0" Then
Return Nothing
Else
Dim cSeparador As String = ""
If Fecha.Contains("de") Then
Fecha = Fecha.Replace(" de ", "-")
End If
If Fecha.Contains("-") Then cSeparador = "-"
If Fecha.Contains("/") Then cSeparador = "/"
If Fecha.Contains(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New Date(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
'Throw New Exception("formato de fecha no soportado")
Else
Dim mFecha() As String
mFecha = Fecha.Split(cSeparador)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New Date(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New Date(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw New Exception(ex.Message, ex)
End If
End Try
End Function
<Extension()>
Public Function FechaStringADateOnly(Fecha As String, Optional NuloSiInvalido As Boolean = True) As DateOnly?
Try
If Fecha = "0" Then
Return Nothing
Else
Dim cSeparador As String = ""
If Fecha.Contains("de") Then
Fecha = Fecha.Replace(" de ", "-")
End If
If Fecha.Contains("-") Then cSeparador = "-"
If Fecha.Contains("/") Then cSeparador = "/"
If Fecha.Contains(".") And cSeparador = "" Then cSeparador = "."
Dim iMes As Integer = 0
If Fecha.ToLower.Contains("ene") OrElse Fecha.ToLower.Contains("enero") Then iMes = 1
If Fecha.ToLower.Contains("feb") OrElse Fecha.ToLower.Contains("febrero") Then iMes = 2
If Fecha.ToLower.Contains("mar") OrElse Fecha.ToLower.Contains("marzo") Then iMes = 3
If Fecha.ToLower.Contains("abr") OrElse Fecha.ToLower.Contains("abril") Then iMes = 4
If Fecha.ToLower.Contains("may") OrElse Fecha.ToLower.Contains("mayo") Then iMes = 5
If Fecha.ToLower.Contains("jun") OrElse Fecha.ToLower.Contains("junio") Then iMes = 6
If Fecha.ToLower.Contains("jul") OrElse Fecha.ToLower.Contains("julio") Then iMes = 7
If Fecha.ToLower.Contains("ago") OrElse Fecha.ToLower.Contains("agosto") Then iMes = 8
If Fecha.ToLower.Contains("sep") OrElse Fecha.ToLower.Contains("septiembre") Then iMes = 9
If Fecha.ToLower.Contains("oct") OrElse Fecha.ToLower.Contains("octubre") Then iMes = 10
If Fecha.ToLower.Contains("nov") OrElse Fecha.ToLower.Contains("noviembre") Then iMes = 11
If Fecha.ToLower.Contains("dic") OrElse Fecha.ToLower.Contains("diciembre") Then iMes = 12
If cSeparador = "" Then
If Fecha.Length = 6 Then Fecha = "19" & Fecha
Return New DateOnly(Integer.Parse(Fecha.Substring(0, 4)), Integer.Parse(Fecha.Substring(4, 2)), Integer.Parse(Fecha.Substring(6, 2)))
'Throw New Exception("formato de fecha no soportado")
Else
Dim mFecha() As String
mFecha = Fecha.Split(cSeparador)
Dim año As Integer = Integer.Parse(mFecha(2).Replace(".", ""))
If año < 100 Then año += 2000
If iMes > 0 Then
Return New DateOnly(año, iMes, Integer.Parse(mFecha(0)))
Else
Return New DateOnly(año, Integer.Parse(mFecha(1).ToString), Integer.Parse(mFecha(0)))
End If
End If
End If
Catch ex As Exception
If NuloSiInvalido Then
Return Nothing
Else
Throw New Exception(ex.Message, ex)
End If
End Try
End Function
<Extension()>
Public Function FechaHoraAstring(FechaHora As DateTime) As String
Return FechaHora.Year.ToString & FechaHora.Month.ToString.PadLeft(2, "0") & FechaHora.Day.ToString.PadLeft(2, "0") & FechaHora.Hour.ToString.PadLeft(2, "0") & FechaHora.Minute.ToString.PadLeft(2, "0") & FechaHora.Second.ToString.PadLeft(2, "0")
End Function
''' <summary>
''' Compute LevenshteinDistance.
''' </summary>
<Extension()>
Public Function LevenshteinDistance(ByVal s As String, ByVal t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim d(n + 1, m + 1) As Integer
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
Dim i As Integer
Dim j As Integer
For i = 0 To n
d(i, 0) = i
Next
For j = 0 To m
d(0, j) = j
Next
For i = 1 To n
For j = 1 To m
Dim cost As Integer
If t(j - 1) = s(i - 1) Then
cost = 0
Else
cost = 1
End If
d(i, j) = Math.Min(Math.Min(d(i - 1, j) + 1, d(i, j - 1) + 1),
d(i - 1, j - 1) + cost)
Next
Next
Return d(n, m)
End Function
<Extension()>
Public Function EliminarComillasTipograficas(s As String) As String
If Not String.IsNullOrEmpty(s) Then
Return s.Replace(""c, "'"c).Replace(""c, "'"c).Replace(ChrW(&H201C), """"c).Replace(ChrW(&H201D), """"c)
Else
Return s
End If
End Function
<Extension()>
Public Function PrimeraLetraMayusculas(s As String) As String
Return s.First().ToString().ToUpper() + [String].Join("", s.Skip(1)).ToLower
End Function
Public Function EliminaPalabrasComunes(palabras As List(Of String)) As List(Of String)
Dim PalabrasAEliminar As String()
PalabrasAEliminar = {"a", "ante", "bajo", "cabe", "con", "contra", "de", "desde", "durante", "en", "entre", "hacia", "hasta", "mediante", "para", "por", "segun", "sin", "so", "sobre", "tras", "versus", "", "via", "el", "la", "lo", "los", "las", "un", "una", "uno", "unos", "al", "del", "que", "ya"}
Return palabras.Except(PalabrasAEliminar).ToList
End Function
'<Extension()>
'Public Function ReemplazarAcentos(value As String) As String
' If (String.IsNullOrEmpty(value)) Then Return String.Empty
' Dim caracteresNoPermitidos As String = "áéíóúàèìòùÁÉÍÓÚÀÈÌÒÙäÄëËïÏöÖüÜ"
' ' NO ELIMINAR LOS CARACTERES REPETIDOS, Y RESPETAR EL ORDEN
' ' EN EL QUE SE ENCUENTRAN DEFINIDOS. Si se añaden más caracteres
' ' no permitidos, añadir en la misma posición su correspondiente
' ' carácter permmitido.
' '
' Dim caracteresPermitidos As String = "aeiouaeiouAEIOUAEIOUaAeEiIoOuU"
' Dim chars As Char() = caracteresNoPermitidos.ToCharArray()
' Dim buffer As New System.Text.StringBuilder(256)
' buffer.Append(value)
' For Each letra As Char In value
' ' NOTA: para utilizar el método Contains hay que
' ' importar el espacio de nombres System.Linq, lo que
' ' significa utilizar .NET 3.5 o superior.
' '
' If (chars.Contains(letra)) Then
' Dim index As Int32 = caracteresNoPermitidos.IndexOf(letra)
' buffer.Replace(letra, caracteresPermitidos(index))
' End If
' Next
' Return buffer.ToString()
'End Function
<Extension()>
Public Function SoloLetrasYNumeros(cadena As String) As String
Dim pattern As String = "[^a-zA-Z0-9ñÑ ]"
Return Regex.Replace(cadena, pattern, String.Empty)
End Function
<Extension()>
Public Function ReemplazarAcentos(value As String) As String
Dim toReplace() As Char = "àèìòùÀÈÌÒÙ äëïöüÄËÏÖÜ âêîôûÂÊÎÔÛ áéíóúÁÉÍÓÚðÐýÝ ãõÃÕšŠžŽçÇåÅøØ".ToCharArray
Dim replaceChars() As Char = "aeiouAEIOU aeiouAEIOU aeiouAEIOU aeiouAEIOUdDyY aoAOsSzZcCaAoO".ToCharArray
For index As Integer = 0 To toReplace.GetUpperBound(0)
value = value.Replace(toReplace(index), replaceChars(index))
Next
Return value
End Function
<Extension()>
Public Function RemoveDiacritics(ByVal text As String) As String
If text IsNot Nothing Then
Dim normalizedString = text.Normalize(NormalizationForm.FormD)
Dim stringBuilder = New StringBuilder(capacity:=normalizedString.Length)
For i As Integer = 0 To normalizedString.Length - 1
Dim c As Char = normalizedString(i)
Dim unicodeCategory = CharUnicodeInfo.GetUnicodeCategory(c)
If unicodeCategory <> unicodeCategory.NonSpacingMark Then
stringBuilder.Append(c)
End If
Next
Return stringBuilder.ToString().Normalize(NormalizationForm.FormC)
Else
Return ""
End If
End Function
<Extension()>
Public Function HexToString(ByVal hex As String) As String
Dim text As New System.Text.StringBuilder(hex.Length \ 2)
For i As Integer = 0 To hex.Length - 2 Step 2
text.Append(Chr(Convert.ToByte(hex.Substring(i, 2), 16)))
Next
Return text.ToString
End Function
End Module
End Namespace

View File

@@ -0,0 +1,20 @@
Option Strict Off
Imports System.Runtime.CompilerServices
Imports System.Linq.Expressions
Namespace Extensiones
Public Module TimeSpanExtensions
<Extension()>
Public Function TimeSpanAHoraString(ByVal ts As TimeSpan?) As String
If ts.HasValue AndAlso ts.Value.Ticks <> 0 Then
If ts.Value.TotalMinutes < 0 Then
Return "-" & Fix(Math.Abs(ts.Value.TotalHours)).ToString.PadLeft(2, "0") & ":" & Math.Abs(CInt(ts.Value.Minutes)).ToString.PadLeft(2, "0")
Else
Return Fix(Math.Abs(ts.Value.TotalHours)).ToString.PadLeft(2, "0") & ":" & Math.Abs(CInt(ts.Value.Minutes)).ToString.PadLeft(2, "0")
End If
Else
Return "00:00"
End If
End Function
End Module
End Namespace