Ya en otra ocasion y a otro usuario de este foro le mande un enciptador y por ende un decriptador espero te sirva
y lo pongo aqui para quien lo necesite
Public Function Decrypt(Expression As String, Key As String)
'Decrypts the specified string using the given numerical decryption key
On Error GoTo ErrHandler
'Declare variables
Dim i As Long
Dim sChar As String
Dim lChrCrypt As Long
Dim sFront As String
Dim sBack As String
Expression = Trim(Expression)
'Decrypt the string
lChrCrypt = 0
For i = 1 To Len(Expression)
lChrCrypt = lChrCrypt + 1
If lChrCrypt > Len(Key) Then lChrCrypt = 1
'Pull the string apart and decrypt one character at a time by moving it down the ASCII chart
sChar = Mid(Expression, i, 1)
'Change to prevent geting Ascii Code < 1
'Thanks to Patrick Di Martino [
[email protected]] for this fix!
If Asc(sChar) - Asc(Mid(Key, lChrCrypt, 1)) < 1 Then
sChar = Chr(Asc(sChar) - Asc(Mid(Key, lChrCrypt, 1)) + 255)
Else
sChar = Chr(Asc(sChar) - Asc(Mid(Key, lChrCrypt, 1)))
End If
sFront = Left(Expression, i - 1)
sBack = Right(Expression, Len(Expression) - i)
'Put the string back together and move on to the next character
Expression = sFront & sChar & sBack
DoEvents
Next
'Return the encrypted string
Decrypt = Expression
'Debug.Print Expression
Exit Function
ErrHandler:
MsgBox Err.Description
Decrypt = 0
Exit Function
End Function
Public Function Encrypt(Expression As String, Key As String)
'Encrypts the specified string using the given numerical encryption key
On Error GoTo ErrHandler
'Declare variables
Dim i As Long
Dim sChar As String
Dim lChrCrypt As Long
Dim sFront As String
Dim sBack As String
Expression = Trim(Expression)
'Encrypt the string
lChrCrypt = 0
For i = 1 To Len(Expression)
lChrCrypt = lChrCrypt + 1
If lChrCrypt > Len(Key) Then lChrCrypt = 1
'Pull the string apart and encrypt one character at a time by moving it up the ASCII chart
sChar = Mid(Expression, i, 1)
'Change to prevent Ascii values > 255
'Thanks to Patrick Di Martino [
[email protected]] for this fix!
If Asc(sChar) + Asc(Mid(Key, lChrCrypt, 1)) > 255 Then
sChar = Chr(Asc(sChar) + Asc(Mid(Key, lChrCrypt, 1)) - 255)
Else
sChar = Chr(Asc(sChar) + Asc(Mid(Key, lChrCrypt, 1)))
End If
sFront = Left(Expression, i - 1)
sBack = Right(Expression, Len(Expression) - i)
'Put the string back together and move on to the next character
Expression = sFront & sChar & sBack
DoEvents
Next
'Return the encrypted string
Encrypt = Expression
Exit Function
ErrHandler:
Encrypt = 0
Exit Function
End Function