client/ClasesModulos/Registro.vb

177 lines
5.4 KiB
VB.net
Raw Normal View History

'******************************
'octubre 2005
'Comentado por No<4E> S<>nchez
'Pernite encriptar y desencriptar el password
Module Registro
Public Function DesEncripta(ByVal Palabra As String) As String
'funcion que toma como parametro un string y lo desencripta
Dim Llave As String, Binario As String
If Len(Palabra) >= 6 Then
Binario = ConvetStringNumToBinary(Palabra)
Binario = Mid(Binario, 5, Len(Binario) - 8)
Llave = ConvetBinaryToString(Binario)
Else
Llave = ""
End If
DesEncripta = Llave
End Function
Function ConvetBinaryToString(ByVal Txt As String) As String
'funcion que toma como parametro un string en binario y lo convierte a un string
Dim ValorResultado As String
Dim i As Integer
Txt = Trim(Txt)
For i = 1 To Len(Txt) Step 8
ValorResultado = ValorResultado & ConvertBinaryToChar(Mid(Txt, i, 8))
Next
ConvetBinaryToString = ValorResultado
End Function
Function ConvertBinaryToChar(ByVal Caracter As String) As String
'Funcion que toma como parametro un caracter en formato binario
Dim ValorAscii As Byte
Dim ValorTxt As String
Dim Division As Integer
Dim i As Integer
Dim Resultado As Integer
ValorTxt = ""
If Len(Caracter) = 8 Then
For i = Len(Caracter) To 1 Step -1
ValorTxt = Mid(Caracter, i, 1)
If ValorTxt = "1" Then
Resultado = Resultado + Potencia(2, 8 - i)
End If
Next
ConvertBinaryToChar = Chr(Resultado)
Else
ConvertBinaryToChar = ""
End If
End Function
Public Function Encripta(ByVal Palabra As String) As String
'funcion que toma como parametro un string y lo encripta
Dim Llave As String, Binario As String
Binario = "1111" & ConvetStringToBinary(Palabra) & "1111"
Llave = ConvetBinaryToStringNum(Binario)
Encripta = Llave
End Function
Function ConvetStringToBinary(ByVal Txt As String) As String
Dim ValorResultado As String
Dim i As Integer
Txt = Trim(Txt)
For i = 1 To Len(Txt)
ValorResultado = ValorResultado & ConvertCharToBinary(Mid(Txt, i, 1))
Next
ConvetStringToBinary = ValorResultado
End Function
Function ConvertCharToBinary(ByVal Caracter As String) As String
Dim ValorAscii As Byte
Dim ValorTxt As String
Dim Division As Integer
ValorTxt = ""
If Len(Caracter) = 1 Then
ValorAscii = Asc(Caracter)
Do
Division = Int(ValorAscii / 2)
ValorTxt = IIf(ValorAscii Mod 2 = 1, "1", "0") & ValorTxt
ValorAscii = Division
Loop While (Division > 0)
ConvertCharToBinary = Mid("00000000", 1, 8 - Len(ValorTxt)) & ValorTxt
Else
ConvertCharToBinary = "00000000"
End If
End Function
Function ConvetStringNumToBinary(ByVal Txt As String) As String
Dim ValorResultado As String
Dim i As Integer
Txt = Trim(Txt)
For i = 1 To Len(Txt) Step 3
ValorResultado = ValorResultado & ConvertNumToBinary(Mid(Txt, i, 3))
Next
ConvetStringNumToBinary = ValorResultado
End Function
Function ConvertNumToBinary(ByVal Caracter As String) As String
Dim ValorTxt As String
Dim Division As Integer
ValorTxt = ""
If Len(Caracter) = 3 Then
Do
Division = Int(Caracter / 2)
ValorTxt = IIf(Caracter Mod 2 = 1, "1", "0") & ValorTxt
Caracter = Division
Loop While (Division > 0)
ConvertNumToBinary = Mid("00000000", 1, 8 - Len(ValorTxt)) & ValorTxt
Else
ConvertNumToBinary = ""
End If
End Function
Function ConvetBinaryToStringNum(ByVal Txt As String) As String
Dim ValorResultado As String
Dim i As Integer
Txt = Trim(Txt)
For i = 1 To Len(Txt) Step 8
ValorResultado = ValorResultado & ConvertBinaryToNum(Mid(Txt, i, 8))
Next
ConvetBinaryToStringNum = ValorResultado
End Function
Function ConvertBinaryToNum(ByVal Caracter As String) As String
Dim ValorAscii As Byte
Dim ValorTxt As String
Dim Division As Integer
Dim i As Integer
Dim Resultado As Integer
Dim ResFinal As String
ValorTxt = ""
ResFinal = ""
If Len(Caracter) = 8 Then
For i = Len(Caracter) To 1 Step -1
ValorTxt = Mid(Caracter, i, 1)
If ValorTxt = "1" Then
Resultado = Resultado + Potencia(2, 8 - i)
End If
Next
ResFinal = Resultado
ConvertBinaryToNum = Mid("000", 1, 3 - Len(ResFinal)) & Resultado
Else
ConvertBinaryToNum = ""
End If
End Function
Function Potencia(ByVal Base As Integer, ByVal Pot As Integer) As Long
Dim Result As Long
Dim i As Integer
If Pot = 0 Then
Result = 1
Else
Result = 1
For i = 1 To Pot
Result = Result * Base
Next
End If
Potencia = Result
End Function
End Module