Mira ahi te dejo estos dos codes, de antemano mencionare que estos no los programe yo, esto lo hizo un amigo de españa.
Pero este tipo de cifrado es bueno, yo mismo lo he usado.
Function lp(txt As String)
'Esta funcion ecnripta el txt
Dim i As Double
Dim aux As String
For i = 1 To Len(txt)
aux = Hex(Asc(Mid(txt, i, 1)))
If aux = "0" Then aux = "00"
If Len(aux) = 1 Then aux = "0" & aux
cad = cad & aux
DoEvents
Next
Dim gol As String
gol = cad
For j = 1 To Len(gol)
lp = lp & Chr(Asc(Mid(gol, j, 1)) Xor 5)
Next
End Function
Otro ejemplo para el mismo efecto:
Function p(txt)
'Esta funcion desencripta el txt
For i = 1 To Len(txt)
des = des & Chr(Asc(Mid(txt, i, 1)) Xor 5)
Next
Dim gole As String
gole = des
Dim j As Double
While j < Len(gole)
For j = 1 To Len(gole)
p = p & Chr(CInt("&h" & Mid(gole, j, 2)))
j = j + 1
Next
Wend
End Function
Espero que sea util.
Saludos.
