Encryptar Clave

Estimado/a wurangoc:
Te mando un código para encriptar y desencriptar, cópialo en un .PRG y ejecutalo:
La forma sencilla de usarlo es enviando 2 parámetros a la función "Encripta": la clave y la llave de encriptación. A la función "Desencripta" hay que enviarle 2 parámetros: la clave encriptada y la llave de desencriptación que debe ser igual a la encriptación.
clave_encriptada = encripta('081065','pepe')
? clave_encriptada
clave_desencriptada = desencripta(clave_encriptada,'pepe')
? clave_desencriptada
return
*---------------------------------------------
* 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
*---------------------------------------------