ENCRIPTAR/DESENCRIPTAR CADENA
Hi :
Tengo el sig. código que descargué de la web, funciona a la perfección el tema es que yo lo quiero para encriptar y desencriptar el campo de Password en una B.D. Oracle, pero al manipular esta parte para ejecutar mi consulta me doy cuenta que los caracteres que interpretan no son los mismos =s
Por lo tanto se me ocurre que si alguien puede reducir el código a manera de que encripte y desencripte utilizando los caracteres (A-Z),(a-z),(0-9)
Para que no haya caracteres raros que permitan confusión entre algún programa.
Aquí pego el Código =d
EXPLICACIÓN DEL CÓDIGO (TOMADA DE LA WEB DEL AUTOR)....
Modelo EncryptionString
EncryptionString, es un clásico sistema el cual toma el mensaje y una clave del usuario, y a través de una combinación de estos dos parámetros se produce una cadena codificada. Mantengo la explicación original del método:
Texto a codificar: ENCRYPTION
Caracteres del Texto: E N C R Y P T I O N
Códigos ASCII: 69 78 67 82 89 80 84 73 79 78
Contraseña KEY: K E Y K E Y K E Y K
Caracteres de KEY: 75 69 89 75 69 89 75 69 89 75
Suma de Códigos ASCII: 144 147 156 157 158 169 159 142 168 153
En caracteres: ? © ? ¨
Texto codificado: ?©?¨
Public Function EncryptString(ByVal UserKey As String, Text As String, Action As Single) As String
'CONSTANTES PARA DEFINIR QUE MÉTODO UTILIZAR EN LA FUNCIÓN EncryptString
Const ENCRYPT = 1, DECRYPT = 2
Dim UserKeyX As String
Dim Temp As Integer
Dim Times As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim rtn As String
'OBTIENE LA CLAVE DEL USUARIO
n = Len(UserKey)
ReDim UserKeyASCIIS(1 To n)
For i = 1 To n
UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
Next
'OBTIENE LA CADENA DE TEXTO
ReDim TextASCIIS(Len(Text)) As Integer
For i = 1 To Len(Text)
TextASCIIS(i) = Asc(Mid$(Text, i, 1))
Next
'ENCRIPTAMOS O DESENCRIPTAMOS SEGÚN EL PARÁMETRO RECIBIDO EN LA FUNCIÓN
If Action = ENCRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) + UserKeyASCIIS(j)
If Temp > 255 Then
Temp = Temp - 255
End If
rtn = rtn + Chr$(Temp)
Next
ElseIf Action = DECRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) - UserKeyASCIIS(j)
If Temp < 0 Then
Temp = Temp + 255
End If
rtn = rtn + Chr$(Temp)
Next
End If
'REGRESAMOS LA CADENA ENCRIPTADA/DESENCRIPTADA
EncryptString = rtn
End Function
grax!!
Tengo el sig. código que descargué de la web, funciona a la perfección el tema es que yo lo quiero para encriptar y desencriptar el campo de Password en una B.D. Oracle, pero al manipular esta parte para ejecutar mi consulta me doy cuenta que los caracteres que interpretan no son los mismos =s
Por lo tanto se me ocurre que si alguien puede reducir el código a manera de que encripte y desencripte utilizando los caracteres (A-Z),(a-z),(0-9)
Para que no haya caracteres raros que permitan confusión entre algún programa.
Aquí pego el Código =d
EXPLICACIÓN DEL CÓDIGO (TOMADA DE LA WEB DEL AUTOR)....
Modelo EncryptionString
EncryptionString, es un clásico sistema el cual toma el mensaje y una clave del usuario, y a través de una combinación de estos dos parámetros se produce una cadena codificada. Mantengo la explicación original del método:
Texto a codificar: ENCRYPTION
Caracteres del Texto: E N C R Y P T I O N
Códigos ASCII: 69 78 67 82 89 80 84 73 79 78
Contraseña KEY: K E Y K E Y K E Y K
Caracteres de KEY: 75 69 89 75 69 89 75 69 89 75
Suma de Códigos ASCII: 144 147 156 157 158 169 159 142 168 153
En caracteres: ? © ? ¨
Texto codificado: ?©?¨
Public Function EncryptString(ByVal UserKey As String, Text As String, Action As Single) As String
'CONSTANTES PARA DEFINIR QUE MÉTODO UTILIZAR EN LA FUNCIÓN EncryptString
Const ENCRYPT = 1, DECRYPT = 2
Dim UserKeyX As String
Dim Temp As Integer
Dim Times As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim rtn As String
'OBTIENE LA CLAVE DEL USUARIO
n = Len(UserKey)
ReDim UserKeyASCIIS(1 To n)
For i = 1 To n
UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
Next
'OBTIENE LA CADENA DE TEXTO
ReDim TextASCIIS(Len(Text)) As Integer
For i = 1 To Len(Text)
TextASCIIS(i) = Asc(Mid$(Text, i, 1))
Next
'ENCRIPTAMOS O DESENCRIPTAMOS SEGÚN EL PARÁMETRO RECIBIDO EN LA FUNCIÓN
If Action = ENCRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) + UserKeyASCIIS(j)
If Temp > 255 Then
Temp = Temp - 255
End If
rtn = rtn + Chr$(Temp)
Next
ElseIf Action = DECRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) - UserKeyASCIIS(j)
If Temp < 0 Then
Temp = Temp + 255
End If
rtn = rtn + Chr$(Temp)
Next
End If
'REGRESAMOS LA CADENA ENCRIPTADA/DESENCRIPTADA
EncryptString = rtn
End Function
grax!!
