Imports System.IO Imports System.Xml Imports System.Xml.Serialization Imports System.Windows.Forms Imports System.Text.RegularExpressions Imports System.Text Imports System.Net Imports System.Net.Security Imports System.Security.Cryptography.X509Certificates Imports Renci.SshNet.Security.Org.BouncyCastle.Math.EC Imports System.Globalization Imports System.Net.Http Imports System.Threading.Tasks Imports System.Web Imports System.Runtime.Serialization Public Enum FormatoFechasEnum As Integer FECHA_HORA = 0 FECHA_SEPARADO_POR_BARRAS = 1 FECHA_ESPACIADO_GRANDE = 2 FECHA_ESPACIADO_PEQUEÑO = 3 End Enum Public Class Utilidades Public Shared Function CodificarBase64(texto As String) As String Dim stringbytes As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(texto) Return System.Convert.ToBase64String(stringbytes).TrimEnd("=").Replace("+", "-").Replace("/", "_") End Function Public Shared Function AscciABase64(texto As String) As String Dim stringbytes As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(texto) Return System.Convert.ToBase64String(stringbytes) End Function Public Shared Function Base64AAscii(texto As String) As String Dim bytes As Byte() = Convert.FromBase64String(texto) Return Encoding.ASCII.GetString(bytes) End Function Public Shared Function DecodificarBase64(texto As String) As String Dim bytes As Byte() = Convert.FromBase64String(texto) Return Encoding.ASCII.GetString(bytes) End Function Public Shared Function ObtieneMensajeExcepcionCompleto(ex As Exception) As String Dim sMensaje As String = "Tipo excepción: " & ex.ToString & vbCrLf Dim exError As Exception = ex Do sMensaje &= exError.StackTrace & vbCrLf exError = exError.InnerException Loop Until IsNothing(exError) Return sMensaje End Function Public Shared Function IntervalosFechasCoincidentes(FechaInicio1 As DateTime, FechaFin1 As DateTime, FechaInicio2 As DateTime, FechaFin2 As DateTime, Optional LimitesIgualesPermitidos As Boolean = False) As Boolean 'Return (FechaInicio1 <= FechaInicio2 And FechaInicio2 < FechaFin1) OrElse (FechaInicio2 <= FechaInicio1 And FechaFin2 > FechaInicio1) ' Return (FechaInicio1 <= FechaInicio2 AndAlso FechaInicio2 <= FechaFin1) OrElse (FechaInicio2 <= FechaInicio1 AndAlso FechaFin2 >= FechaInicio1) If LimitesIgualesPermitidos Then Return FechaInicio1 < FechaFin2 AndAlso FechaInicio2 < FechaFin1 Else Return FechaInicio1 <= FechaFin2 AndAlso FechaInicio2 <= FechaFin1 End If End Function Public Shared Sub CreaEstructuraDirectorio(ByVal Ruta As String) Dim sDirectorios() As String = Ruta.Split("\") Dim sDirectorio As String = "" Dim i As Integer For i = 0 To sDirectorios.Length - 1 Try sDirectorio &= sDirectorios(i) & "\" If Not IO.Directory.Exists(sDirectorio) Then IO.Directory.CreateDirectory(sDirectorio) Catch ex As Exception End Try Next End Sub Public Shared Function Deserializa(ByVal BA As Byte(), ByVal tipo As System.Type, Optional SinErrores As Boolean = False) As Object Dim xs As New System.Xml.Serialization.XmlSerializer(tipo) If SinErrores Then AddHandler xs.UnknownElement, AddressOf ElementoDesconocido AddHandler xs.UnknownNode, AddressOf NodoDesconocido AddHandler xs.UnknownAttribute, AddressOf AtributoDesconocido AddHandler xs.UnreferencedObject, AddressOf ObjetoNoReferenciado End If 'Dim fs As New FileStream(Fichero, FileMode.Open, FileAccess.Read) Dim ms As New MemoryStream(BA) Dim obj As Object = xs.Deserialize(ms) '.Close() Return obj End Function Public Shared Function DeserializaFichero(ByVal Fichero As String, ByVal tipo As System.Type) As Object Dim xs As New System.Xml.Serialization.XmlSerializer(tipo) Dim fs As New FileStream(Fichero, FileMode.Open, FileAccess.Read) Dim obj As Object = xs.Deserialize(fs) fs.Close() Return obj End Function Public Shared Function Serializar(ByVal obj As Object) As String Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) Dim sw As New StringWriter se.Serialize(sw, obj) Return sw.ToString End Function 'Public Shared Function serializarBase64(ByVal obj As Object, Codificacion As System.Text.Encoding) As String ' Dim xs As New System.Xml.Serialization.XmlSerializer(obj.GetType) ' Dim sw As New StringWriter ' xs.Serialize(sw, obj) ' Dim str = sw.ToString ' Dim b = Codificacion.GetBytes(str) ' Return sw.ToString 'End Function Public Shared Sub SerializarUTF8(ByVal obj As Object, FicheroDestino As String) Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) If IO.File.Exists(FicheroDestino) Then IO.File.Delete(FicheroDestino) Dim fs As New IO.FileStream(FicheroDestino, FileMode.CreateNew) Dim settings = New XmlWriterSettings() With settings .Encoding = UTF8Encoding.UTF8 .NewLineOnAttributes = True .Indent = True End With Dim xmlw = XmlWriter.Create(fs, settings) se.Serialize(xmlw, obj) fs.Close() End Sub Public Shared Function SerializarUTF8(ByVal obj As Object) As String Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) Dim sb As New StringBuilder Dim settings = New XmlWriterSettings() With settings .Encoding = UTF8Encoding.UTF8 .NewLineOnAttributes = True .Indent = True End With Dim xmlw = XmlWriter.Create(sb, settings) se.Serialize(xmlw, obj) Return sb.ToString End Function Public Shared Sub Serializar(ByVal obj As Object, FicheroDestino As String, Optional EliminarNamespace As Boolean = False) Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) If IO.File.Exists(FicheroDestino) Then IO.File.Delete(FicheroDestino) Dim fs As New IO.FileStream(FicheroDestino, FileMode.CreateNew) If EliminarNamespace Then Dim xmlNamespace = New XmlSerializerNamespaces() xmlNamespace.Add(String.Empty, "https://filezilla-project.org") se.Serialize(fs, obj, xmlNamespace) Else se.Serialize(fs, obj) End If fs.Close() End Sub Public Shared Function SerializarAByteArray(ByVal obj As Object) As Byte() Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) Dim ms As New MemoryStream se.Serialize(ms, obj) Return ms.ToArray End Function Public Shared Function SerializarSinDeclaracion(ByVal obj As Object) As String Dim ms As New MemoryStream Dim settings As New XmlWriterSettings Dim utf8 As New System.Text.UTF8Encoding settings.OmitXmlDeclaration = True settings.Indent = True settings.Encoding = utf8 Dim xw As XmlWriter = XmlWriter.Create(ms, settings) Dim ns As New XmlSerializerNamespaces() ns.Add("", "") Dim se As New System.Xml.Serialization.XmlSerializer(obj.GetType) se.Serialize(xw, obj, ns) Return utf8.GetString(ms.ToArray) End Function Public Shared Sub ByteArrayAFichero(Datos() As Byte, NombreFichero As String, Optional Sobreescribir As Boolean = False) If Not IO.Directory.Exists(IO.Path.GetDirectoryName(NombreFichero)) Then CreaEstructuraDirectorio(IO.Path.GetDirectoryName(NombreFichero)) If IO.File.Exists(NombreFichero) And Sobreescribir Then IO.File.Delete(NombreFichero) Dim oFileStream As System.IO.FileStream oFileStream = New System.IO.FileStream(NombreFichero, System.IO.FileMode.Create) oFileStream.Write(Datos, 0, Datos.Length) oFileStream.Close() End Sub Public Shared Function deserializar(ByVal cadena As String, ByVal tipo As System.Type) As Object Dim xs As New System.Xml.Serialization.XmlSerializer(tipo) Dim sr As New StringReader(cadena) Dim xr As New System.Xml.XmlTextReader(sr) Dim obj As Object = xs.Deserialize(xr) xr.Close() sr.Close() Return obj End Function Public Shared Function DeserializarSinErrores(ByVal cadena As String, ByVal tipo As System.Type) As Object Return deserializar(cadena, tipo, True) End Function Public Shared Function deserializar(ByVal cadena As String, ByVal tipo As System.Type, Optional SinErrores As Boolean = True) As Object Dim xs As New System.Xml.Serialization.XmlSerializer(tipo) If SinErrores Then AddHandler xs.UnknownElement, AddressOf ElementoDesconocido AddHandler xs.UnknownNode, AddressOf NodoDesconocido AddHandler xs.UnknownAttribute, AddressOf AtributoDesconocido AddHandler xs.UnreferencedObject, AddressOf ObjetoNoReferenciado End If Dim sr As New StringReader(cadena) Dim xr As New System.Xml.XmlTextReader(sr) Dim obj As Object = xs.Deserialize(xr) xr.Close() sr.Close() Return obj End Function Private Shared Sub ObjetoNoReferenciado(sender As Object, e As UnreferencedObjectEventArgs) End Sub Private Shared Sub AtributoDesconocido(sender As Object, e As XmlAttributeEventArgs) End Sub Private Shared Sub NodoDesconocido(sender As Object, e As XmlNodeEventArgs) End Sub Private Shared Sub ElementoDesconocido(sender As Object, e As XmlElementEventArgs) End Sub Public Shared Function ObtieneFicheroNoExistente(DirectorioInicial As String, Nombre As String, ByVal Extension As String) As String If Not IO.Directory.Exists(DirectorioInicial) Then IO.Directory.CreateDirectory(DirectorioInicial) Dim sFichero As String = DirectorioInicial & Nombre & "." & Extension.TrimStart(".") Dim i As Integer = 0 Do While IO.File.Exists(sFichero) i += 1 sFichero = DirectorioInicial & Nombre & "_" & i.ToString & "." & Extension.TrimStart(".") Loop Return sFichero End Function Public Shared Function ObtieneFicheroAleatorio(DirectorioInicial As String, ByVal Extension As String) As String If Not IO.Directory.Exists(DirectorioInicial) Then IO.Directory.CreateDirectory(DirectorioInicial) Dim sFichero As String = DirectorioInicial & System.IO.Path.GetRandomFileName & "." & Extension Do While IO.File.Exists(sFichero) 'Try ' IO.File.Delete(sFichero) 'Catch ex As Exception sFichero = DirectorioInicial & System.IO.Path.GetRandomFileName & "." & Extension ' End Try Loop Return sFichero End Function Public Shared Function ObtieneFicheroAleatorio(ByVal Extension As String) As String Dim sFichero As String = System.IO.Path.GetTempPath & System.IO.Path.GetRandomFileName & "." & Extension Do While IO.File.Exists(sFichero) 'Try ' IO.File.Delete(sFichero) 'Catch ex As Exception sFichero = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName & "." & Extension ' End Try Loop Return sFichero End Function Public Shared Function ObtieneDirectorioAleatorio() As String Dim sDir As String = System.IO.Path.GetTempPath & System.IO.Path.GetRandomFileName Do While IO.Directory.Exists(sDir) sDir = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName Loop IO.Directory.CreateDirectory(sDir) Return sDir End Function Public Shared Function ObtieneDirectorioAleatorioInicial(DirectorioInicial As String) As String Dim sDir As String = DirectorioInicial.TrimEnd("\") & "\" & System.IO.Path.GetRandomFileName & "\" Do While IO.Directory.Exists(sDir) Or IO.File.Exists(sDir) sDir = DirectorioInicial.TrimEnd("\") & "\" & System.IO.Path.GetRandomFileName & "\" Loop IO.Directory.CreateDirectory(sDir) Return sDir End Function Public Shared Function ObtieneDirectorioAleatorio(Subdirectorio As String) As String If Not IO.Directory.Exists(System.IO.Path.GetTempPath & "\" & Subdirectorio & "\") Then IO.Directory.CreateDirectory(System.IO.Path.GetTempPath & "\" & Subdirectorio & "\") Dim sDir As String = System.IO.Path.GetTempPath & "\" & Subdirectorio & "\" & System.IO.Path.GetRandomFileName Do While IO.Directory.Exists(sDir) Or IO.File.Exists(sDir) sDir = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName Loop IO.Directory.CreateDirectory(sDir) Return sDir End Function Public Shared Function EliminaDirectorioTemporal(Subdirectorio As String) As String Dim sDir As String = System.IO.Path.GetTempPath & "\" & Subdirectorio & "\" If IO.Directory.Exists(sDir) Then Try IO.Directory.Delete(sDir, True) Catch ex As Exception End Try End If End Function Public Shared Sub CopiaDirectorio(ByVal DirectorioOrigen As String, ByVal DirectorioDestino As String, ByVal Recursivo As Boolean, ByVal SobreEscribir As Boolean, Optional ByRef EtiquetaProgreso As Label = Nothing, Optional ByRef BarraProgreso As ProgressBar = Nothing, Optional ByRef NumeroFicherosACopiar As Integer = 0, Optional ByRef OmitirBloqueados As Boolean = False, Optional ByVal Doevents As Boolean = True) If Not BarraProgreso Is Nothing Then If BarraProgreso.Tag = "CANCELAR" Then Exit Sub End If Try If Not BarraProgreso Is Nothing And NumeroFicherosACopiar = 0 Then NumeroFicherosACopiar = ObtieneNumeroFicheros(DirectorioOrigen) BarraProgreso.Maximum = NumeroFicherosACopiar End If Dim sDir As String Dim dDirInfo As IO.DirectoryInfo Dim sDirInfo As IO.DirectoryInfo Dim sFile As String Dim sFileInfo As IO.FileInfo Dim dFileInfo As IO.FileInfo ' Add trailing separators to the supplied paths if they don't exist. If Not DirectorioOrigen.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then DirectorioOrigen &= System.IO.Path.DirectorySeparatorChar End If If Not DirectorioDestino.EndsWith(System.IO.Path.DirectorySeparatorChar.ToString()) Then DirectorioDestino &= System.IO.Path.DirectorySeparatorChar End If 'If destination directory does not exist, create it. dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino) If dDirInfo.Exists = False Then dDirInfo.Create() dDirInfo = Nothing ' Recursive switch to continue drilling down into directory structure. If Recursivo Then ' Get a list of directories from the current parent. For Each sDir In System.IO.Directory.GetDirectories(DirectorioOrigen) sDirInfo = New System.IO.DirectoryInfo(sDir) dDirInfo = New System.IO.DirectoryInfo(DirectorioDestino & sDirInfo.Name) ' Create the directory if it does not exist. If dDirInfo.Exists = False Then dDirInfo.Create() ' Since we are in recursive mode, copy the children also CopiaDirectorio(sDirInfo.FullName, dDirInfo.FullName, Recursivo, SobreEscribir, EtiquetaProgreso, BarraProgreso, NumeroFicherosACopiar, OmitirBloqueados, Doevents) sDirInfo = Nothing dDirInfo = Nothing Next End If ' Get the files from the current parent. For Each sFile In System.IO.Directory.GetFiles(DirectorioOrigen) sFileInfo = New System.IO.FileInfo(sFile) dFileInfo = New System.IO.FileInfo(Replace(sFile, DirectorioOrigen, DirectorioDestino)) 'If File does not exist. Copy. If Not EtiquetaProgreso Is Nothing Then EtiquetaProgreso.Text = "Copiando " & sFileInfo.FullName & " ..." End If Try sFileInfo.CopyTo(dFileInfo.FullName, SobreEscribir) Catch ex As Exception If Not OmitirBloqueados Then Throw New Exception(ex.Message, ex) End Try If Doevents Then System.Windows.Forms.Application.DoEvents() If Not BarraProgreso Is Nothing Then If BarraProgreso.Tag = "CANCELAR" Then Exit Sub BarraProgreso.Value = Math.Min(BarraProgreso.Maximum, BarraProgreso.Value + 1) End If sFileInfo = Nothing dFileInfo = Nothing Next Catch ex As Exception Throw New Exception("Error en Copiadirectorio. " & ex.Message, ex) 'MsgBox(ex.Message, MsgBoxStyle.Exclamation, "CopiaDirectorio") End Try End Sub Public Shared Function ObtieneNumeroFicheros(ByVal Directory As String) As Integer Dim FileCount As Integer = 0 Dim SubDirectory() As String Dim i As Integer FileCount = System.IO.Directory.GetFiles(Directory).Length SubDirectory = System.IO.Directory.GetDirectories(Directory) For i = 0 To SubDirectory.Length - 1 FileCount = ObtieneNumeroFicheros(SubDirectory(i)) + FileCount Next Return FileCount End Function Public Shared Sub ObtieneFicherosRecursivo(ByVal Ruta As String, ByRef Ficheros() As String) Dim sFicheros() As String = IO.Directory.GetFiles(Ruta) Dim iNumeroFicheros As Integer If Not IsNothing(Ficheros) Then iNumeroFicheros = Ficheros.Length ReDim Preserve Ficheros(sFicheros.Length - 1 + iNumeroFicheros) sFicheros.CopyTo(Ficheros, iNumeroFicheros) Dim sDirectorio, sDirectorios() As String sDirectorios = IO.Directory.GetDirectories(Ruta) For Each sDirectorio In sDirectorios ObtieneFicherosRecursivo(sDirectorio, Ficheros) Next End Sub Public Shared Function FechaEnCastellano(ByVal Fecha As Date, ByVal Formato As FormatoFechasEnum) As String Dim sMeses(11) As String sMeses(0) = "Enero" sMeses(1) = "Febrero" sMeses(2) = "Marzo" sMeses(3) = "Abril" sMeses(4) = "Mayo" sMeses(5) = "Junio" sMeses(6) = "Julio" sMeses(7) = "Agosto" sMeses(8) = "Septiembre" sMeses(9) = "Octubre" sMeses(10) = "Noviembre" sMeses(11) = "Diciembre" Dim sDia As String, sMes As String, sAño As String sDia = Fecha.Day.ToString sMes = sMeses(Fecha.Month - 1) sAño = Fecha.Year Select Case Formato Case FormatoFechasEnum.FECHA_ESPACIADO_GRANDE FechaEnCastellano = sDia & " de " & sMes & " de " & sAño Case FormatoFechasEnum.FECHA_HORA FechaEnCastellano = Fecha.Day.ToString.PadLeft(2, "0") & "/" & Fecha.Month.ToString.PadLeft(2, "0") & "/" & Fecha.Year.ToString & " " & Fecha.Hour.ToString.PadLeft(2, "0") & ":" & Fecha.Minute.ToString.PadLeft(2, "0") & ":" & Fecha.Second.ToString.PadLeft(2, "0") Case FormatoFechasEnum.FECHA_ESPACIADO_PEQUEÑO FechaEnCastellano = sDia & " de " & sMes & " de " & sAño Case FormatoFechasEnum.FECHA_SEPARADO_POR_BARRAS FechaEnCastellano = Fecha.Day.ToString.PadLeft(2, "0") & "/" & Fecha.Month.ToString.PadLeft(2, "0") & "/" & Fecha.Year.ToString Case Else Throw New Exception("Formato no reconocido") End Select End Function Public Shared Function MesCastellano(Mes As Integer) As String Dim sMeses(11) As String sMeses(0) = "Enero" sMeses(1) = "Febrero" sMeses(2) = "Marzo" sMeses(3) = "Abril" sMeses(4) = "Mayo" sMeses(5) = "Junio" sMeses(6) = "Julio" sMeses(7) = "Agosto" sMeses(8) = "Septiembre" sMeses(9) = "Octubre" sMeses(10) = "Noviembre" sMeses(11) = "Diciembre" Return sMeses(Mes - 1) End Function Public Shared Function ObtenerRutaDelEnsamblado() As String Return IO.Path.GetDirectoryName(IO.Path.GetFullPath(New System.Uri(System.Reflection.Assembly.GetExecutingAssembly().CodeBase).AbsolutePath)) End Function Public Class Mes Property NumeroMes As Integer Property Mes As String End Class Public Shared Function Meses() As List(Of Mes) Dim listadoMeses As New List(Of Mes) Dim m As Mes m = New Mes m.NumeroMes = 1 m.Mes = "Enero" listadoMeses.Add(m) m = New Mes m.NumeroMes = 2 m.Mes = "Febrero" listadoMeses.Add(m) m = New Mes m.NumeroMes = 3 m.Mes = "Marzo" listadoMeses.Add(m) m = New Mes m.NumeroMes = 4 m.Mes = "Abril" listadoMeses.Add(m) m = New Mes m.NumeroMes = 5 m.Mes = "Mayo" listadoMeses.Add(m) m = New Mes m.NumeroMes = 6 m.Mes = "Junio" listadoMeses.Add(m) m = New Mes m.NumeroMes = 7 m.Mes = "Julio" listadoMeses.Add(m) m = New Mes m.NumeroMes = 8 m.Mes = "Agosto" listadoMeses.Add(m) m = New Mes m.NumeroMes = 9 m.Mes = "Septiembre" listadoMeses.Add(m) m = New Mes m.NumeroMes = 10 m.Mes = "Octubre" listadoMeses.Add(m) m = New Mes m.NumeroMes = 11 m.Mes = "Noviembre" listadoMeses.Add(m) m = New Mes m.NumeroMes = 12 m.Mes = "Diciembre" listadoMeses.Add(m) Return listadoMeses End Function Public Shared Function CalculoLetraCif(ByVal DNI As String) As String ' Dim sResultado As String = "", iTamanoDNI As Integer, sLetrasNif As String, i As Integer, Cdd0 As Integer, V1 As String = "" Dim sResultado As String = "", iTamanoDNI As Integer, sLetrasNif As String, i As Integer, V1 As String = "" sLetrasNif = "TRWAGMYFPDXBNJZSQVHLCKE" iTamanoDNI = Len(DNI) If iTamanoDNI = 0 Or iTamanoDNI > 10 Then Return DNI DNI = DNI.ToUpper For i = 1 To iTamanoDNI If Asc(Mid(DNI, i, 1)) >= 48 And Asc(Mid(DNI, i, 1)) <= 57 Or Asc(Mid(DNI, i, 1)) >= 65 And Asc(Mid(DNI, i, 1)) <= 90 Then sResultado = sResultado & Mid(DNI, i, 1) Next i iTamanoDNI = Len(sResultado) If iTamanoDNI = 0 Then Return sResultado End If If Asc(Mid(sResultado, 1, 1)) < 48 Or Asc(Mid(sResultado, 1, 1)) > 57 Or Asc(Mid(sResultado, iTamanoDNI, 1)) < 48 Or Asc(Mid(sResultado, iTamanoDNI, 1)) > 57 Then Return sResultado End If ' Cdd0 = 0 For i = 1 To iTamanoDNI ' If Cdd0 Or (Asc(Mid(sResultado, i, 1)) <> 48) Then If Asc(Mid(sResultado, i, 1)) >= 48 And Asc(Mid(sResultado, i, 1)) <= 57 Then V1 = V1 & Mid(sResultado, i, 1) ' Cdd0 = 1 ' End If Next i If Trim(V1) = "" Then Return V1 If V1.Length < 9 Then V1 = V1.PadLeft(8, "0") Return V1 & Mid(sLetrasNif, Val(V1) Mod 23 + 1, 1) End Function Public Shared Function ValidateNif(ByRef nif As String) As Boolean '******************************************************************* ' Nombre: ValidateNif ' por Enrique Martínez Montejo ' ' Finalidad: Validar el NIF/NIE pasado a la función. ' ' Entradas: ' NIF: String. El NIF/NIE que xs desea verificar. El número ' será devuelto formateado y con el NIF/NIE correcto. ' Resultados: ' Boolean: True/False ' '******************************************************************* nif = nif.Trim() Dim nifTemp As String = nif.Trim().ToUpper() If (nifTemp.Length > 9) Then Return False ' Guardamos el dígito de control. Dim dcTemp As Char = nifTemp.Chars(nif.Length - 1) ' Compruebo si el dígito de control es un número. If (Char.IsDigit(dcTemp)) Then Return Nothing ' Nos quedamos con los caracteres, sin el dígito de control. nifTemp = nifTemp.Substring(0, nif.Length - 1) If (nifTemp.Length < 8) Then Dim paddingChar As String = New String("0"c, 8 - nifTemp.Length) nifTemp = nifTemp.Insert(nifTemp.Length, paddingChar) End If ' Obtengo el dígito de control correspondiente, utilizando ' para ello una llamada a la función GetDcNif. ' Dim dc As Char = GetDcNif(nif) If (Not (dc = Nothing)) Then nif = nifTemp & dc End If Return (dc = dcTemp) End Function Public Shared Function GetDcNif(ByVal nif As String) As Char '******************************************************************* ' Nombre: GetDcNif ' por Enrique Martínez Montejo ' ' Finalidad: Devuelve la letra correspondiente al NIF o al NIE ' (Número de Identificación de Extranjero) ' ' Entradas: ' NIF: String. La cadena del NIF cuya letra final xs desea ' obtener. ' ' Resultados: ' String: La letra del NIF/NIE. ' '******************************************************************* ' Pasamos el NIF a mayúscula a la vez que eliminamos los ' espacios en blanco al comienzo y al final de la cadena. ' nif = nif.Trim().ToUpper() ' El NIF está formado de uno a nueve números seguido de una letra. ' ' El NIF de otros colectivos de personas físicas, está ' formato por una letra (K, L, M), seguido de 7 números ' y de una letra final. ' ' El NIE está formado de una letra inicial (X, Y, Z), ' seguido de 7 números y de una letra final. ' ' En el patrón de la expresión regular, defino cuatro grupos en el ' siguiente orden: ' ' 1º) 1 a 8 dígitos. ' 2º) 1 a 8 dígitos + 1 letra. ' 3º) 1 letra + 1 a 7 dígitos. ' 4º) 1 letra + 1 a 7 dígitos + 1 letra. ' Try Dim re As New Regex( "(^\d{1,8}$)|(^\d{1,8}[A-Z]$)|(^[K-MX-Z]\d{1,7}$)|(^[K-MX-Z]\d{1,7}[A-Z]$)", RegexOptions.IgnoreCase) If (Not (re.IsMatch(nif))) Then Return Nothing ' Nos quedamos únicamente con los números del NIF, y ' los formateamos con ceros a la izquierda si su ' longitud es inferior a siete caracteres. ' re = New Regex("(\d{1,8})") Dim numeros As String = re.Match(nif).Value.PadLeft(7, "0"c) ' Primer carácter del NIF. ' Dim firstChar As Char = nif.Chars(0) ' Si procede, reemplazamos la letra del NIE por el peso que le corresponde. ' If (firstChar = "X"c) Then numeros = "0" & numeros ElseIf (firstChar = "Y"c) Then numeros = "1" & numeros ElseIf (firstChar = "Z"c) Then numeros = "2" & numeros End If ' Tabla del NIF ' ' 0T 1R 2W 3A 4G 5M 6Y 7F 8P 9D ' 10X 11B 12N 13J 14Z 15S 16Q 17V 18H 19L ' 20C 21K 22E 23T ' ' Procedo a calcular el NIF/NIE ' Dim dni As Integer = CInt(numeros) ' La operación consiste en calcular el resto de dividir el DNI ' entre 23 (sin decimales). Dicho resto (que estará entre 0 y 22), ' xs busca en la tabla y nos da la letra del NIF. ' ' Obtenemos el resto de la división. ' Dim r As Integer = dni Mod 23 ' Obtenemos el dígito de control del NIF ' Dim dc As Char = CChar("TRWAGMYFPDXBNJZSQVHLCKE".Substring(r, 1)) Return dc Catch ' Cualquier excepción producida, devolverá el valor Nothing. ' Return Nothing End Try End Function Public Shared Function RecalculaNIF(ByVal nif As String) As Char '******************************************************************* ' Nombre: GetDcNif ' por Enrique Martínez Montejo ' ' Finalidad: Devuelve la letra correspondiente al NIF o al NIE ' (Número de Identificación de Extranjero) ' ' Entradas: ' NIF: String. La cadena del NIF cuya letra final xs desea ' obtener. ' ' Resultados: ' String: La letra del NIF/NIE. ' '******************************************************************* ' Pasamos el NIF a mayúscula a la vez que eliminamos los ' espacios en blanco al comienzo y al final de la cadena. ' nif = nif.Trim().ToUpper() ' El NIF está formado de uno a nueve números seguido de una letra. ' ' El NIF de otros colectivos de personas físicas, está ' formato por una letra (K, L, M), seguido de 7 números ' y de una letra final. ' ' El NIE está formado de una letra inicial (X, Y, Z), ' seguido de 7 números y de una letra final. ' ' En el patrón de la expresión regular, defino cuatro grupos en el ' siguiente orden: ' ' 1º) 1 a 8 dígitos. ' 2º) 1 a 8 dígitos + 1 letra. ' 3º) 1 letra + 1 a 7 dígitos. ' 4º) 1 letra + 1 a 7 dígitos + 1 letra. ' Try Dim re As New Regex( "(^\d{1,8}$)|(^\d{1,8}[A-Z]$)|(^[K-MX-Z]\d{1,7}$)|(^[K-MX-Z]\d{1,7}[A-Z]$)", RegexOptions.IgnoreCase) If (Not (re.IsMatch(nif))) Then Return Nothing ' Nos quedamos únicamente con los números del NIF, y ' los formateamos con ceros a la izquierda si su ' longitud es inferior a siete caracteres. ' re = New Regex("(\d{1,8})") Dim numeros As String = re.Match(nif).Value.PadLeft(7, "0"c) ' Primer carácter del NIF. ' Dim firstChar As Char = nif.Chars(0) ' Si procede, reemplazamos la letra del NIE por el peso que le corresponde. ' If (firstChar = "X"c) Then numeros = "0" & numeros ElseIf (firstChar = "Y"c) Then numeros = "1" & numeros ElseIf (firstChar = "Z"c) Then numeros = "2" & numeros End If ' Tabla del NIF ' ' 0T 1R 2W 3A 4G 5M 6Y 7F 8P 9D ' 10X 11B 12N 13J 14Z 15S 16Q 17V 18H 19L ' 20C 21K 22E 23T ' ' Procedo a calcular el NIF/NIE ' Dim dni As Integer = CInt(numeros) ' La operación consiste en calcular el resto de dividir el DNI ' entre 23 (sin decimales). Dicho resto (que estará entre 0 y 22), ' xs busca en la tabla y nos da la letra del NIF. ' ' Obtenemos el resto de la división. ' Dim r As Integer = dni Mod 23 ' Obtenemos el dígito de control del NIF ' Dim dc As Char = CChar("TRWAGMYFPDXBNJZSQVHLCKE".Substring(r, 1)) Dim NifCorregido As String = numeros & dc Return NifCorregido Catch ' Cualquier excepción producida, devolverá el valor Nothing. ' Return Nothing End Try End Function Public Shared Function ConvertirTiempoUnixADateTime(ByVal tiempoUnix As Long) Dim fecha As New DateTime(1970, 1, 1, 0, 0, 0, 0, System.DateTimeKind.Utc) System.Diagnostics.Debug.WriteLine(fecha.AddSeconds(tiempoUnix).ToLocalTime.ToString) System.Diagnostics.Debug.WriteLine(fecha.AddSeconds(tiempoUnix).ToLocalTime.ToUniversalTime) Return fecha.AddSeconds(tiempoUnix).ToUniversalTime End Function Public Shared Function UpCast(Of B, S As {New, B})(ByVal baseObj As B) As S Dim superObj As S = New S() Dim superProp As System.Reflection.PropertyInfo = Nothing For Each baseProp As System.Reflection.PropertyInfo In baseObj.GetType().GetProperties() superProp = superObj.GetType().GetProperty(baseProp.Name) superProp.SetValue(superObj, baseProp.GetValue(baseObj, Nothing), Nothing) Next Return superObj End Function Public Shared Function GetHexString(source As String) As String Dim b As Byte() = System.Text.Encoding.UTF8.GetBytes(source) Return BitConverter.ToString(b).Replace("-", "") End Function Public Shared Function StringToHex(ByVal text As String) As String Dim shex As String = "" For i As Integer = 0 To text.Length - 1 shex &= Asc(text.Substring(i, 1)).ToString("x").ToUpper Next Return shex End Function Public Shared 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 Public Shared Function HexToArray(ByVal hex As String) As Byte() Dim raw As Byte() = New Byte((hex.Length / 2) - 1) {} Dim i As Integer For i = 0 To raw.Length - 1 raw(i) = Convert.ToByte(hex.Substring((i * 2), 2), &H10) Next i Return raw End Function Public Shared Function GetUnixTimestamp() As Integer Return GetUnixTime(DateTime.UtcNow) End Function Public Shared Function GetUnixTime(ByVal dt As DateTime) As Integer Dim span As TimeSpan = (dt - New DateTime(1970, 1, 1, 0, 0, 0, 0).ToLocalTime()) Return span.TotalSeconds End Function Public Shared Function ByteArrayToHex(ByVal bytes_Input As Byte()) As String Dim strTemp As New StringBuilder(bytes_Input.Length * 2) For Each b As Byte In bytes_Input strTemp.Append(Conversion.Hex(b).PadLeft(2, "0")) Next Return strTemp.ToString() End Function Public Shared Function Ttagi(ByVal sValortag As String, ByVal sToken As String) As String Ttagi = "" Try sValortag = "|" & sValortag & "|" If InStr(1, "|" & sValortag & "|", "|" & sToken & "=", vbTextCompare) > 0 Then Ttagi = Mid(sValortag, (InStr(1, sValortag, "|" & sToken & "=") + Len(sToken) + 2), InStr(1, Mid(sValortag, InStr(1, sValortag, "|" & sToken & "=") + Len(sToken) + 2), "|") - 1) End If Catch ex As Exception Throw ex End Try End Function Public Shared Function FindType(ByVal name As String) As Type Dim base As Type base = Reflection.Assembly.GetEntryAssembly.GetType(name, False, True) If base IsNot Nothing Then Return base base = Reflection.Assembly.GetExecutingAssembly.GetType(name, False, True) If base IsNot Nothing Then Return base For Each assembly As Reflection.Assembly In AppDomain.CurrentDomain.GetAssemblies base = assembly.GetType(name, False, True) If base IsNot Nothing Then Return base Next Throw New Exception("Clase no encontrada") End Function Public Shared Function StringAFechaHora(ByVal Fecha As String) As DateTime Dim sValores() As String = Fecha.Split("_") Dim dFecha As DateTime dFecha = New DateTime(sValores(0), sValores(1), sValores(2), sValores(3), sValores(4), sValores(5)) Return dFecha End Function ''' ''' ''' ''' ''' ''' Esto es de Manuel Pulido. ''' Public Shared Function TryParseDateTimeOffset(ByVal sFecha As String, ByRef fecha As DateTimeOffset) As Boolean Dim resultado As Boolean If String.IsNullOrWhiteSpace(sFecha) Then resultado = False Else If sFecha.Trim().ToUpper().EndsWith("Z") Then sFecha = sFecha.Trim().ToUpper().Replace("Z", "") sFecha = sFecha.Replace("T", " ") End If resultado = DateTimeOffset.TryParseExact( sFecha, { "yyyy-MM-dd HH:mm:ss", "yyyy-MM-dd HH:mm:ssz", "yyyy-MM-dd HH:mm:sszz", "yyyy-MM-dd HH:mm:sszzz", "yyyy-MM-ddTHH:mm:ss", "yyyy-MM-ddTHH:mm:ssz", "yyyy-MM-ddTHH:mm:sszz", "yyyy-MM-ddTHH:mm:sszzz", "d/M/yyyy HH:mm:ss", "d/M/yy HH:mm:ss", "dd/MM/yyyy HH:mm:ss zzz", "yyyyMMddHHmmsszz", "d/M/yyyy", "dd/MM/yyyy", "d/M/yy", "dd/MM/yy", "yyyy-MM-dd" }, System.Globalization.CultureInfo.InvariantCulture.DateTimeFormat, System.Globalization.DateTimeStyles.AssumeLocal, fecha ) Debug.WriteLine($"{sFecha} = {fecha}") End If Return resultado End Function Public Shared Async Function EnviarNotificacionSlack( ByVal mensaje As String, Optional ByVal otroTexto As String = "", Optional ByVal destinatario As String = "", Optional ByVal descripcionRemitente As String = "" ) As Task(Of String) Dim resultado As String = "" Const maxRetries As Integer = 2 Dim attempt As Integer = 0 Dim delayTask As Task = Nothing ' Escapar las cadenas para compatibilizarlas con JSON mensaje = HttpUtility.JavaScriptStringEncode(mensaje) otroTexto = HttpUtility.JavaScriptStringEncode(otroTexto) destinatario = HttpUtility.JavaScriptStringEncode(destinatario) descripcionRemitente = HttpUtility.JavaScriptStringEncode(descripcionRemitente) ' Asignar valores por defecto If String.IsNullOrWhiteSpace(destinatario) Then destinatario = "#notificaciones" End If Dim machineName As String = Environment.MachineName.ToUpper().Trim() If machineName = "INTI" OrElse machineName = "CERBERO" OrElse machineName = "QUISQUILLA" Then destinatario = "@danmun" End If If String.IsNullOrWhiteSpace(descripcionRemitente) Then descripcionRemitente = String.Format(".NET {0}@{1}", Environment.UserName, Environment.MachineName) End If Dim mensajeJSON As String = "" If String.IsNullOrWhiteSpace(otroTexto) Then mensajeJSON = String.Format("{{""channel"": ""{0}"", ""username"": ""notificaciones"", ""text"": ""*{1}* — {2}""}}", destinatario.Trim(), descripcionRemitente.Trim(), mensaje.Trim()) Else mensajeJSON = String.Format("{{""channel"": ""{0}"", ""username"": ""notificaciones"", ""text"": ""*{1}* — {2} — _{3}_""}}", destinatario.Trim(), descripcionRemitente.Trim(), mensaje.Trim(), otroTexto.Trim()) End If ' Configurar HttpClientHandler para aceptar todos los certificados Dim handler As New HttpClientHandler() handler.ServerCertificateCustomValidationCallback = Function(sender, cert, chain, sslPolicyErrors) True Dim requestUri As String = "https://hooks.slack.com/services/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" Dim postData As String = "payload=" & HttpUtility.UrlEncode(mensajeJSON) Using client As New HttpClient(handler) client.DefaultRequestHeaders.ExpectContinue = False ' Bucle de reintentos Dim continuar As Boolean = True While continuar ' Crear el contenido (se debe recrear en cada intento) Dim content As New StringContent(postData, System.Text.Encoding.UTF8, "application/x-www-form-urlencoded") Try Dim response As HttpResponseMessage = Await client.PostAsync(requestUri, content) resultado = Await response.Content.ReadAsStringAsync() Debug.WriteLine("Respuesta: " & resultado) If response.Headers.Contains("Retry-After") Then Dim retryValues = response.Headers.GetValues("Retry-After") For Each value As String In retryValues Debug.WriteLine("Retry-After: " & value) Exit For Next End If If response.IsSuccessStatusCode Then ' Éxito, salimos del bucle continuar = False ElseIf response.StatusCode = 429 Then ' Error 429: tomar el tiempo indicado o 45 segundos por defecto Dim delaySeconds As Integer = 45 If response.Headers.Contains("Retry-After") Then Dim retryValue As String = response.Headers.GetValues("Retry-After").FirstOrDefault() If Not Integer.TryParse(retryValue, delaySeconds) Then delaySeconds = 45 End If End If Debug.WriteLine(String.Format("Rate limit excedido. Esperando {0} segundos antes del reintento...", delaySeconds)) attempt += 1 If attempt > maxRetries Then Debug.WriteLine("Se alcanzó el número máximo de reintentos.") continuar = False Else delayTask = Task.Delay(delaySeconds * 1000) End If Else ' Otros errores HTTP: salir sin reintentar Debug.WriteLine("Error HTTP: " & response.StatusCode.ToString()) continuar = False End If Catch ex As HttpRequestException Debug.WriteLine("HttpRequestException: " & ex.Message) attempt += 1 If attempt > maxRetries Then continuar = False Else Debug.WriteLine("Reintentando tras error de conexión en 45 segundos...") delayTask = Task.Delay(45000) End If End Try ' Si se asignó un Task de retraso, se espera fuera del bloque Catch If delayTask IsNot Nothing Then Await delayTask delayTask = Nothing End If End While End Using Return resultado End Function Private Shared Function AcceptAllCertifications(sender As Object, certificate As X509Certificate, chain As X509Chain, sslPolicyErrors As SslPolicyErrors) As Boolean Return True End Function Public Shared Function GenerarCsvDesdeDataTable(dt As DataTable, Optional ByVal separador As Char = ";") As String Dim sb As New Text.StringBuilder() For i As Integer = 0 To dt.Columns.Count - 1 sb.Append("""" & dt.Columns(i).ToString & """") If i < dt.Columns.Count - 1 Then sb.Append(separador) End If Next sb.AppendLine() For Each dr As DataRow In dt.Rows For i As Integer = 0 To dt.Columns.Count - 1 sb.Append("""" & dr(i).ToString() & """") If i < dt.Columns.Count - 1 Then sb.Append(separador) End If Next sb.AppendLine() Next Return sb.ToString() End Function ''' ''' Descripción de este método: ''' ''' 1. Recibe una cadena de texto que representa un nombre de archivo. ''' 2. Elimina del nombre de archivo los caracteres inválidos para Windows. ''' 3. Devuelve el nombre de archivo con los caracteres inválidos eliminados. ''' ''' Añadido por danmun en 2023-08-25. ''' ''' File name, not path. ''' Public Shared Function SanitizeFileName(input As String) As String Dim invalidChars As Char() = Path.GetInvalidFileNameChars() Dim sanitized As String = String.Join("_", input.Split(invalidChars, StringSplitOptions.RemoveEmptyEntries)) Return sanitized End Function Public Shared Function ObtenerPrimerDiaMes(año As Integer, mes As Integer, DiaSemana As DayOfWeek) As Date Dim fechaInicial As New Date(año, mes, 1) While fechaInicial.DayOfWeek <> DiaSemana fechaInicial = fechaInicial.AddDays(1) End While Return fechaInicial End Function End Class Public Class DescripcionValor Property Descripcion As String Property Valor As Integer Property Habilitado As Boolean 'ReadOnly Property Habilitado As Boolean ' Get ' If _ListaDesHabilitados Is Nothing Then ' Return True ' Else ' Return Not _ListaDesHabilitados.Contains(Valor) ' End If ' End Get 'End Property ' Private _ListaDesHabilitados As List(Of Integer) Public Shared Function EnumADescripcionValor(Enumeracion As Type, Optional ListaDesHabilitados As List(Of Integer) = Nothing) As List(Of DescripcionValor) Dim values As Array = [Enum].GetValues(Enumeracion) Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion) 'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length) Dim lista As New List(Of DescripcionValor) For i As Integer = 0 To values.Length - 1 Dim dv As New DescripcionValor 'dv._ListaDesHabilitados = ListaHabilitados dv.Valor = values.GetValue(i) If ListaDesHabilitados Is Nothing Then dv.Habilitado = True Else dv.Habilitado = (ListaDesHabilitados.Contains(dv.Valor) = False) End If dv.Descripcion = values(i).ToString.Replace("_", " ") lista.Add(dv) Next Return lista End Function Public Shared Function EnumADescripcionValorAmpliado(Enumeracion As Type) As List(Of DescripcionValor) Dim values As Array = [Enum].GetValues(Enumeracion) Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion) 'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length) Dim lista As New List(Of DescripcionValor) For i As Integer = 0 To values.Length - 1 Dim dv As New DescripcionValor dv.Valor = values.GetValue(i) dv.Descripcion = values(i).ToString.Replace("_", " ") & " (" & dv.Valor.ToString & ")" lista.Add(dv) Next Return lista End Function End Class Public Class DescripcionValorAlfabetico Property Descripcion As String Property Valor As String Property Habilitado As Boolean 'ReadOnly Property Habilitado As Boolean ' Get ' If _ListaDesHabilitados Is Nothing Then ' Return True ' Else ' Return Not _ListaDesHabilitados.Contains(Valor) ' End If ' End Get 'End Property ' Private _ListaDesHabilitados As List(Of Integer) Public Shared Function EnumADescripcionValor(Enumeracion As Type, Optional ListaDesHabilitados As List(Of Integer) = Nothing) As List(Of DescripcionValorAlfabetico) Dim values As Array = [Enum].GetValues(Enumeracion) Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion) 'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length) Dim lista As New List(Of DescripcionValorAlfabetico) For i As Integer = 0 To values.Length - 1 Dim dv As New DescripcionValorAlfabetico 'dv._ListaDesHabilitados = ListaHabilitados dv.Valor = values.GetValue(i) If ListaDesHabilitados Is Nothing Then dv.Habilitado = True Else dv.Habilitado = (ListaDesHabilitados.Contains(dv.Valor) = False) End If dv.Descripcion = values(i).ToString.Replace("_", " ") lista.Add(dv) Next Return lista End Function Public Shared Function EnumADescripcionValorAmpliado(Enumeracion As Type) As List(Of DescripcionValorAlfabetico) Dim values As Array = [Enum].GetValues(Enumeracion) Dim underlyingType As Type = [Enum].GetUnderlyingType(Enumeracion) 'Dim arr As Array = Array.CreateInstance(underlyingType, values.Length) Dim lista As New List(Of DescripcionValorAlfabetico) For i As Integer = 0 To values.Length - 1 Dim dv As New DescripcionValorAlfabetico dv.Valor = values.GetValue(i) dv.Descripcion = values(i).ToString.Replace("_", " ") & " (" & dv.Valor.ToString & ")" lista.Add(dv) Next Return lista End Function End Class