Con esta rutina podemos encriptar/desencriptar una clave de acceso
La función Encripta() tiene tres parámetros Cadena a encriptar: La cadena que queremos encriptar. Llave: Llave para encriptar. Para desencriptar debemos usar la misma "llave". Bandera: Esta bandera me permite indicar si la cadena a encriptar puede ser desencriptada.
La función Desencripta() tiene dos parámetros Cadena a desencriptar: La cadena que queremos desencriptar. Llave: Llave para desencriptar. Esta "llave" debe ser la misma que usamos para encriptar.
Como ejemplo podemos usar:
lc = Encripta("MiClave", "MiLlave")
? lc
? Desencripta(lc, "MiLlave")
Si agregamos la bandera para no desencriptar obtenemos:lc = Encripta("MiClave", "MiLlave", .T.)
? lc
? Desencripta(lc, "MiLlave")
Con esto le podemos dar seguridad a nuestros usuarios que "nadie" puede saber su clave de acceso. Para comparar la clave de acceso ingresada, la debemos encriptar con la "llave" y la "bandera" en .T., y recién allí comparo la clave encriptada con la guardada en nuestra tabla.
La "llave" utilizada puede ser el nombre de usuario, con esto la misma contraseña para dos usuarios distintos, una vez encriptada será diferente.
Las funciones en VFP 6 son las siguientes:
*---------------------------------------------
* Función que encripta una cadena
* Parámetros:
* tcCadena - Cadena a encriptar
* tcLlave - Llave para encriptar (Debe ser la misma para Desencriptar)
* tlSinDesencripta - .F. para proceso que se puede usar Desencripta
* Los textos encriptados con este tlSinDesencripta en .T. no se pueden
* desencriptar, ya que el mecanismo de encriptamiento utilizado
* produce perdida de informacion que impide la inversion del proceso
* Retorno: Caracter (el doble de largo que el texto pasado)
*---------------------------------------------
FUNCTION Encripta(tcCadena, tcLlave, tlSinDesencripta)
LOCAL lc, ln, lcRet
LOCAL lnClaveMul, lnClaveXor
IF EMPTY(tcLlave)
tcLlave = ""
ENDIF
=GetClaves(tcLlave,@lnClaveMul,@lnClaveXor)
lcRet = ""
lc = tcCadena
DO WHILE LEN(lc) > 0
ln = BITXOR(ASC(lc)*(lnClaveMul+1),lnClaveXor)
IF tlSinDesencripta
*-- Encripta de modo que no se puede desencriptar
ln = BITAND(ln+(ln%256)*17+INT(ln/256)*135+ ;
INT(ln/256)*(ln%256),65535)
ENDIF
lcRet = lcRet+BINTOC(ln-32768,2)
lnClaveMul = BITAND(lnClaveMul+59,0xFF)
lnClaveXor = BITAND(BITNOT(lnClaveXor),0xFFFF)
lc = IIF(LEN(lc) > 1,SUBS(lc,2),"")
ENDDO
RETURN lcRet
ENDFUNC
*---------------------------------------------
* Función que desencripta una cadena encriptada
* Parámetros:
* tcCadena - Cadena a desencriptar
* tcLlave - Llave para desencriptar (Debe ser la misma de Encriptar)
* Retorno: Caracter (la mitad de largo que el texto pasado)
*---------------------------------------------
FUNCTION Desencripta(tcCadena, tcLlave)
LOCAL lc, ln, lcRet, lnByte
LOCAL lnClaveMul, lnClaveXor
IF EMPTY(tcLlave)
tcLlave = ""
ENDIF
=GetClaves(tcLlave, @lnClaveMul, @lnClaveXor)
lcRet = ""
FOR ln = 1 TO LEN(tcCadena)-1 STEP 2
lnByte = BITXOR(CTOBIN(SUBS(tcCadena, ln,2))+ ;
32768,lnClaveXor)/(lnClaveMul+1)
lnClaveMul = BITAND(lnClaveMul+59, 0xFF)
lnClaveXor = BITAND(BITNOT(lnClaveXor), 0xFFFF)
lcRet = lcRet+CHR(IIF(BETWEEN(lnByte,0,255),lnByte,0))
ENDFOR
RETURN lcRet
ENDFUNC
*---------------------------------------------
* Función usada por Encripta y Desencripta
*---------------------------------------------
FUNCTION GetClaves(tcLlave, tnClaveMul, tnClaveXor)
LOCAL lc, ln
lc = ALLTRIM(LOWER(tcLlave))
tnClaveMul = 31
tnClaveXor = 3131
DO WHILE NOT EMPTY(lc)
tnClaveMul = BITXOR(tnClaveMul,ASC(lc))
tnClaveXor = BITAND((tnClaveXor+1)*(ASC(lc)+1),0xFFFF)
lc = IIF(LEN(lc) > 1,SUBS(lc,2),"")
ENDDO
ENDFUNC
*---------------------------------------------