Esta es una clase, para encriptar la informacion, la encriptación no usa un algoritmo muy elevado, pero funciona bien.


Pegen esto en un modulo de clase(*.cls), con el nombre ClsEncrypt

Código:

'Set Encripta = New cEncrypt
'sResultado = Encripta.ConvertirClave(CadenaxDesencriptar, sClave, False)
'False=desencriptar, True =Encriptar
Option Explicit


Public Enum eEncrypt
 eDesencriptar = 0
 eEncriptar = 1
End Enum


Private m_Accion As eEncrypt


' Variable privadas para las propiedades
Private m_sOriginal As String
Private m_sClave As String
Private Const mc_sClave As String = "123456"


' Si se debe devolver error al fallar en la asignación
' por defecto es True
Private m_RaiseError As Boolean


Public Function ConvertirClave(Optional ByVal sOriginal As String = "", _
   Optional ByVal sClave As String = "", _
   Optional vAccion As Variant) As String
 Dim LenOri As Long
 Dim LenClave As Long
 Dim i As Long, j As Long
 Dim cO As Long, cC As Long
 Dim k As Long
 Dim v As String
 
 ' Si no se especifican los parámetros,
 ' se usarán los valores de las propiedades
 If Len(sOriginal) = 0 Then _
 sOriginal = m_sOriginal
 
 If Len(sClave) = 0 Then _
 sClave = m_sClave
 
 ' Si se especifica el último parámetro,
 If Not IsMissing(vAccion) Then
 ' usar nuestra propiedad para convertir el valor
 Me.Accion = vAccion
 End If
 
 LenOri = Len(sOriginal)
 LenClave = Len(sClave)
 
 v = Space$(LenOri)
 i = 0&
 For j = 1 To LenOri
 i = i + 1
 If i > LenClave Then
  i = 1
 End If
 cO = Asc(Mid$(sOriginal, j, 1))
 cC = Asc(Mid$(sClave, i, 1))
 If m_Accion Then
  k = cO + cC
  If k > 255 Then
  k = k - 255
  End If
 Else
  k = cO - cC
  If k < 0 Then
  k = k + 255
  End If
 End If
 Mid$(v, j, 1) = Chr$(k)
 Next
 
 ConvertirClave = v
End Function


Public Function DesEncriptar(Optional ByVal sOriginal As String = "", _
    Optional ByVal sClave As String = "") As String
 ' Esta es una función que llamará directamente a ConvertirClave
 '
 m_Accion = eDesencriptar
 DesEncriptar = ConvertirClave(sOriginal, sClave)
End Function


Public Function Encriptar(Optional ByVal sOriginal As String = "", _
    Optional ByVal sClave As String = "") As String
 ' Esta es una función que llamará directamente a ConvertirClave
 '
 m_Accion = eEncriptar
 Encriptar = ConvertirClave(sOriginal, sClave)
End Function


Public Property Get CadenaOriginal() As String
 CadenaOriginal = m_sOriginal
End Property


Public Property Let CadenaOriginal(ByVal NewValue As String)
 ' Sólo asignar si la cadena tiene algún contenido
 If Len(NewValue) Then
 m_sOriginal = NewValue
 Else
 ' Devolver un error, si así se ha indicado
 If m_RaiseError Then
  With Err
  .Description = "Se debe asignar algún contenido a la cadena a encryptar / desencriptar"
  .Number = 13
  .Source = "cEncrypt::CadenaOriginal"
  .Raise .Number
  End With
 End If
 End If
End Property


Public Property Get Clave() As String
 Clave = m_sClave
End Property


Public Property Let Clave(ByVal NewValue As String)
 ' Sólo asignar si la cadena tiene algún contenido
 If Len(NewValue) Then
 m_sClave = NewValue
 Else
 ' Devolver un error, si así se ha indicado
 If m_RaiseError Then
  With Err
  .Description = "Se debe asignar algún contenido a la cadena a usar como clave para encriptar / desencriptar"
  .Number = 13
  .Source = "cEncrypt::Clave"
  .Raise .Number
  End With
 Else
  ' Si no, devolver el valor por defecto
  m_sClave = mc_sClave
 End If
 End If
End Property


Private Sub Class_Initialize()
 ' Por defecto devolver error
 m_RaiseError = True
 ' Clave por defecto
 m_sClave ="Jamec"
 ' Por defecto se encriptará
 m_Accion = eEncriptar
End Sub


Public Property Get RaiseError() As Boolean
 RaiseError = m_RaiseError
End Property


Public Property Let RaiseError(ByVal NewValue As Boolean)
 m_RaiseError = NewValue
End Property


Public Property Get Accion() As eEncrypt
 Accion = m_Accion
End Property


Public Property Let Accion(ByVal NewValue As eEncrypt)
 ' Si el valor indicado es 0 será Descencriptar,
 ' si es cualquier otro valor, será encriptar
 ' De esta forma se aceptarán valores boolenos
 If NewValue = 0 Then
 m_Accion = eDesencriptar
 Else
 m_Accion = eEncriptar
 End If
End Property

Para usarla utilizan:

Código:

Dim Encripta As New ClsEncrypt
TextoEnc = Encripta.ConvertirClave(Texto, Clave, True)'encriptar
TextoEnc = Encripta.ConvertirClave(Texto, txtClave, False) 'Desencriptar

Edited by: Jamec