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

505
crypt.vb Normal file
View File

@@ -0,0 +1,505 @@
Imports System.IO
Imports System.Security.Cryptography
Public Class crypt
Public Shared Function FEncS$(ByVal X$, ByVal Jco0$, ByVal Jcd0$, ByVal Xs0 As Long)
Dim T$, Resultado$, Jco$, Jcd$, Cd$, Co$
Dim R, F, Lo0, Ld0, Lx, Ld, Xs, Po, Lo, Pd, Px, Spac As Long
Dim SEncDes, I As Integer
Resultado$ = ""
If Xs0 = 0 Then ' Traduccion de tokens <xx>
T$ = X$
Do
F = 0
If Left$(T$, 3) = "[V]" Then Resultado$ = Resultado$ + "" : T$ = Mid$(T$, 4) : F = 1
If Left$(T$, 4) = "[AM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" : T$ = Mid$(T$, 5) : F = 1
If Left$(T$, 4) = "[Am]" Then Resultado$ = Resultado$ + "abcdefghijklmnopqrstuvwxyz" : T$ = Mid$(T$, 5) : F = 1
If Left$(T$, 3) = "[N]" Then Resultado$ = Resultado$ + "0123456789" : T$ = Mid$(T$, 4) : F = 1
If Left$(T$, 4) = "[AN]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" : T$ = Mid$(T$, 5) : F = 1
'If Left$(T$, 5) = "[ANM]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" : T$ = Mid$(T$, 6) : F = 1
If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
' If Left$(T$, 5) = "[JO1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\* =#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
' If Left$(T$, 5) = "[JD1]" Then Resultado$ = Resultado$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789ÁÉÍÓÚáéíóúÄËÏÖÜäëïöüÂÊÎÔÛâêîôûºªÑñÇç'.,+-_@/\*)=#|!:;$%&" : T$ = Mid$(T$, 6) : F = 1
Loop Until F = 0
FEncS$ = Resultado$ + T$
Exit Function
End If
If Math.Abs(Xs0) < 100000000.0 Then Error 11
SEncDes = Math.Sign(Xs0) ' +1 o -1
If SEncDes > 0 Then ' inversion de parametros si Desencriptacion
Jco$ = Jco0$ : Jcd$ = Jcd0$
Else
Jco$ = Jcd0$ : Jcd$ = Jco0$
End If
Jco$ = FEncS$(Jco$, "", "", 0)
Jcd$ = FEncS$(Jcd$, "", "", 0)
Lo0 = Len(Jco$) : Ld0 = Len(Jcd$)
Lo = Lo0 + -256 * (Lo0 = 0) : Ld = Ld0 + -256 * (Ld0 = 0)
If SEncDes > 0 Then Lx = Ld Else Lx = Lo
Xs = Math.Abs(Xs0) + 611957 * (Len(X$) Mod 1000) ' ????
' R = FRndL(-(ABS(Xs0) + 1000000 * (LEN(X$) MOD 1000)))
Spac = Math.Abs(Xs0) Mod Lx
For I = 1 To Len(X$)
Co$ = Mid$(X$, I, 1)
If Lo0 <> 0 Then Po = InStr(Jco$, Co$) Else Po = Asc(Co$) + 1
If Po = 0 Then Resultado$ = "" : Error 11
Xs = 16807 * (Xs Mod 127773) - 2836 * (Xs \ 127773)
If Xs < 0 Then Xs = Xs + 2147483647
R = Int((Xs / 2147483647.0#) * Lx)
' R1 = INT(FRndL(0) * Lx)
' IF R <> R1 THEN STOP
Pd = ((Po - 1) + SEncDes * (R + Spac) + 2 * Lx) Mod Lx + 1
If SEncDes > 0 Then Px = Po Else Px = Pd
Spac = (Spac + Px * 17) Mod Lx
If Ld0 <> 0 Then Cd$ = Mid$(Jcd$, Pd, 1) Else Cd$ = Chr(Pd - 1)
Resultado$ = Resultado$ + Cd$
Next I
FEncS$ = Resultado$
End Function
Public Shared Function SHA1ASCII(ByVal strToHash As String) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA1(ByVal strToHash As String) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = System.Text.Encoding.Unicode.GetBytes(strToHash)
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA1(ByVal Datos() As Byte) As String
Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
Dim bytesToHash() As Byte = Datos
bytesToHash = sha1Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA256(ByVal Datos() As Byte) As String
Dim sha256Obj As New Security.Cryptography.SHA256CryptoServiceProvider
Dim bytesToHash() As Byte = Datos
bytesToHash = sha256Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function SHA256(ByVal Cadena As String) As String
Dim sha256Obj As New Security.Cryptography.SHA256CryptoServiceProvider
Dim Datos() As Byte = System.Text.Encoding.Unicode.GetBytes(Cadena)
Dim bytesToHash() As Byte = Datos
bytesToHash = sha256Obj.ComputeHash(bytesToHash)
Dim strResult As String = ""
For Each b As Byte In bytesToHash
strResult += b.ToString("x2")
Next
Return strResult.ToUpper
End Function
Public Shared Function ObtenerCadenaHashSHA256AportandoSal(ByVal cadenaQueQuieroHashear As String, ByVal sal As String)
Dim sb As Text.StringBuilder = New Text.StringBuilder()
For Each b As Byte In GetHashSHA256(cadenaQueQuieroHashear, sal)
sb.Append(b.ToString("X2"))
Next
Return sb.ToString()
End Function
Private Shared Function GetHashSHA256(ByVal cadenaQueQuieroHashear As String, ByVal sal As String) As Byte()
Using ha As Security.Cryptography.HashAlgorithm = Security.Cryptography.SHA256.Create()
Return ha.ComputeHash(Text.Encoding.UTF8.GetBytes(String.Format("{0}{1}", cadenaQueQuieroHashear.Trim(), sal.Trim())))
End Using
End Function
Public Shared Function AES(ByVal streamOrigen As Stream,
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
ByVal streamDestino As Stream,
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Long
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de AES() para streams.
'-------------------------------------------------------------------------------------------
' streamOrigen: Fuente de los datos. Se encripta/desencripta 'streamOrigen' AL COMPLETO,
' independientemente de la posición de su cabeza lectora.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta AES (128 bits, 192 bits o 256 bits).
' IV: Vector de inicialización (16 bytes).
'
' streamDestino: Destino de los datos encriptados/desencriptados.
' Los datos encriptados/desencriptados se escriben A PARTIR DE LA POSICIÓN
' EN LA QUE SE ENCUENTRE LA CABEZA ESCRITORA de'streamDestino'.
'
' padding: Modo de padding. Por defecto padding PKCS #7.
'
' VALOR DEVUELTO: Número de bytes escritos en 'streamDestino'.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase AesCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
' Tamaño del buffer de lectura/escritura (en bytes).
' Se lee/escribe en bloques de TAM_BUFFER bytes.
Const TAM_BUFFER As Integer = 4 * 1024
Try
If streamOrigen Is Nothing Then Throw New Exception("'streamOrigen' es Nothing.")
If clave Is Nothing Then Throw New Exception("'clave' es Nothing.")
If IV Is Nothing Then Throw New Exception("'IV' es Nothing.")
If streamDestino Is Nothing Then Throw New Exception("'streamDestino' es Nothing.")
'---------------
Dim aesCSP As New AesCryptoServiceProvider()
aesCSP.Padding = padding
aesCSP.Mode = CipherMode.CBC
aesCSP.Key = clave
aesCSP.IV = IV
'---------------
Dim ctransform As ICryptoTransform
If encriptar Then
ctransform = aesCSP.CreateEncryptor()
Else
ctransform = aesCSP.CreateDecryptor()
End If
'---------------
Dim cstream As New CryptoStream(streamDestino, ctransform, CryptoStreamMode.Write)
'-------------------------------------------------------------------
' Leemos datos desde 'streamOrigen' y los escribimos en 'cstream',
' que a su vez los escribe en 'streamDestino' previa aplicación de
' la transformación de encriptación/desencriptación.
'-------------------------------------------------------------------
' Leemos 'streamOrigen' desde el principio:
streamOrigen.Position = 0
Dim buffer(TAM_BUFFER - 1) As Byte
Dim n As Integer ' Número de bytes leídos en la iteración actual.
Dim posInicialDestino As Long = streamDestino.Position
While True
n = streamOrigen.Read(buffer, 0, TAM_BUFFER)
If n = 0 Then
' Fin del stream
Exit While
End If
cstream.Write(buffer, 0, n)
End While
cstream.FlushFinalBlock()
Dim posFinalDestino As Long = streamDestino.Position
' Se devuelve el número de bytes escritos en 'streamDestino':
Return posFinalDestino - posInicialDestino
Catch ex As Exception
Throw New Exception("Calculando AES." & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function AES(ByVal bytesOrigen As Byte(),
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Byte()
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de AES() para arrays de bytes.
'-------------------------------------------------------------------------------------------
' bytesOrigen: Fuente de los datos para la encriptación/desencriptación.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta AES (128 bits, 192 bits o 256 bits).
' IV: Vector de inicialización (16 bytes).
'
' padding: Modo de padding. Por defecto padding PKCS #7.
'
' VALOR DEVUELTO: Array de bytes resultado de la encriptación/desencriptación.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase AesCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
If bytesOrigen Is Nothing Then
Throw New Exception("Calculando AES: 'bytesOrigen' es Nothing.")
End If
Dim streamOrigen As New MemoryStream(bytesOrigen)
Dim streamDestino As New MemoryStream()
AES(streamOrigen, encriptar, clave, IV, streamDestino, padding)
Return streamDestino.ToArray()
End Function
'------------------------
Public Shared Function TripleDES(ByVal streamOrigen As Stream,
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
ByVal streamDestino As Stream,
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Long
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de TripleDES() para streams.
'-------------------------------------------------------------------------------------------
' streamOrigen: Fuente de los datos. Se encripta/desencripta 'streamOrigen' AL COMPLETO,
' independientemente de la posición de su cabeza lectora.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta TripleDES (128 bits o 192 bits).
' IV: Vector de inicialización (8 bytes).
'
' streamDestino: Destino de los datos encriptados/desencriptados.
' Los datos encriptados/desencriptados se escriben A PARTIR DE LA POSICIÓN
' EN LA QUE SE ENCUENTRE LA CABEZA ESCRITORA de'streamDestino'.
'
' padding: Modo de padding. Por defecto padding PKCS #7 (= padding PKCS #5).
'
' VALOR DEVUELTO: Número de bytes escritos en 'streamDestino'.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase TripleDESCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
' Tamaño del buffer de lectura/escritura (en bytes).
' Se lee/escribe en bloques de TAM_BUFFER bytes.
Const TAM_BUFFER As Integer = 4 * 1024
Try
If streamOrigen Is Nothing Then Throw New Exception("'streamOrigen' es Nothing.")
If clave Is Nothing Then Throw New Exception("'clave' es Nothing.")
If IV Is Nothing Then Throw New Exception("'IV' es Nothing.")
If streamDestino Is Nothing Then Throw New Exception("'streamDestino' es Nothing.")
'---------------
Dim tdesCSP As New TripleDESCryptoServiceProvider()
tdesCSP.Padding = padding
tdesCSP.Mode = CipherMode.CBC
tdesCSP.Key = clave
tdesCSP.IV = IV
'---------------
Dim ctransform As ICryptoTransform
If encriptar Then
ctransform = tdesCSP.CreateEncryptor()
Else
ctransform = tdesCSP.CreateDecryptor()
End If
'---------------
Dim cstream As New CryptoStream(streamDestino, ctransform, CryptoStreamMode.Write)
'-------------------------------------------------------------------
' Leemos datos desde 'streamOrigen' y los escribimos en 'cstream',
' que a su vez los escribe en 'streamDestino' previa aplicación de
' la transformación de encriptación/desencriptación.
'-------------------------------------------------------------------
' Leemos 'streamOrigen' desde el principio:
streamOrigen.Position = 0
Dim buffer(TAM_BUFFER - 1) As Byte
Dim n As Integer ' Número de bytes leídos en la iteración actual.
Dim posInicialDestino As Long = streamDestino.Position
While True
n = streamOrigen.Read(buffer, 0, TAM_BUFFER)
If n = 0 Then
' Fin del stream
Exit While
End If
cstream.Write(buffer, 0, n)
End While
cstream.FlushFinalBlock()
Dim posFinalDestino As Long = streamDestino.Position
' Se devuelve el número de bytes escritos en 'streamDestino':
Return posFinalDestino - posInicialDestino
Catch ex As Exception
Throw New Exception("Calculando TripleDES." & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function TripleDES(ByVal bytesOrigen As Byte(),
ByVal encriptar As Boolean,
ByVal clave As Byte(),
ByVal IV As Byte(),
Optional ByVal padding As PaddingMode = PaddingMode.PKCS7) As Byte()
'-------------------------------------------------------------------------------------------
' Versión sobrecargada de TripleDES() para arrays de bytes.
'-------------------------------------------------------------------------------------------
' bytesOrigen: Fuente de los datos para la encriptación/desencriptación.
'
' encriptar: Si True, se encripta; si False, se desencripta.
'
' clave: Clave secreta TripleDES (128 bits o 192 bits).
' IV: Vector de inicialización (8 bytes).
'
' padding: Modo de padding. Por defecto padding PKCS #7 (= padding PKCS #5).
'
' VALOR DEVUELTO: Array de bytes resultado de la encriptación/desencriptación.
'
'-------------------------------------------------------------------------------------------
' INFORMACIÓN ADICIONAL:
' - Se usa la clase TripleDESCryptoServiceProvider.
' - Se usa el modo de cifrado CBC (Cipher Block Chaining).
'-------------------------------------------------------------------------------------------
If bytesOrigen Is Nothing Then
Throw New Exception("Calculando TripleDES: 'bytesOrigen' es Nothing.")
End If
Dim streamOrigen As New MemoryStream(bytesOrigen)
Dim streamDestino As New MemoryStream()
TripleDES(streamOrigen, encriptar, clave, IV, streamDestino, padding)
Return streamDestino.ToArray()
End Function
'------------------------
Public Shared Function ArrayAleatorio(ByVal numBytes As Integer) As Byte()
'----------------------------------------------------
' Devuelve un array de bytes de longitud 'numBytes'.
' Los bytes son rellenados con valores aleatorios
' generados de manera criptográficamente sólida.
'----------------------------------------------------
Dim rng As New RNGCryptoServiceProvider()
Dim a(numBytes - 1) As Byte
rng.GetBytes(a)
Return a
End Function
Public Shared Function ArraysIguales(ByVal a1 As Byte(), ByVal a2 As Byte(),
Optional ByVal longitudMin As Integer = -1) As Boolean
'-------------------------------------------------------------------------------------
' Devuelve True si los dos arrays de bytes 'a1' y 'a2' coinciden; False en otro caso.
'-------------------------------------------------------------------------------------
' 'longitudMin' indica la longitud mínima exigida de los arrays para ser considerados
' iguales; si NO se cumple, se devuelve FALSE. Casos:
'
' longitudMin = -1 --> Permite TODO (se considera que Nothing = Nothing es True)
' = 0 --> NO PERMITE Nothings, SÍ PERMITE VACÍOS.
' > 0 --> Requiere que 'a1' y 'a2' tengan al menos esa longitud.
'
'-------------------------------------------------------------------------------------
If longitudMin < -1 Then
Throw New Exception("ArraysIguales(): Parámetro longitudMin < -1")
End If
'------
If (a1 Is Nothing) OrElse (a2 Is Nothing) Then
Return (longitudMin = -1) And (a1 Is Nothing) And (a2 Is Nothing)
End If
If a1.Length <> a2.Length Then Return False
If a1.Length < longitudMin Then Return False
Dim i As Integer
For i = 0 To (a1.Length - 1)
If a1(i) <> a2(i) Then Return False
Next
Return True
End Function
Public Shared Function ArrayToHex(ByVal a As Byte(), Optional ByVal separador As String = "") As String
'--------------------------------------------------------------------------------------------------
' Transforma un array de bytes a un string en hexadecimal (cada byte se representa en hexadecimal).
' Los caracteres alfabéticos hexadecimales SIEMPRE SE REPRESENTAN EN MAYÚSCULAS (ABCDEF).
'--------------------------------------------------------------------------------------------------
' 'separador' es el string separador de bytes (POR DEFECTO VACÍO).
'--------------------------------------------------------------------------------------------------
Dim res As String = ""
If (a IsNot Nothing) AndAlso (a.Length > 0) Then
Dim i As Integer
For i = 0 To (a.Length - 2)
res &= [String].Format("{0:X2}", a(i)) & separador
Next
res &= [String].Format("{0:X2}", a(a.Length - 1))
End If
Return res
End Function
End Class