Esta clase te permitirá codificar (o encriptar) una cadena en caracteres "extraños" que no significarán nada para cualquier curioso... por supuesto, también permite lo contrario, partiendo de una cadena previamente codificada, decodificarla.
La clase tiene varias propiedades y tres métodos, veamos lo que hace cada una de las "partes" de la clase y después veremos el código, así como un ejemplo de cómo usarla.
Propiedades:
Accion Indica lo que se debe hacer y puede tomar dos valores: Encriptar o Desencriptar, según lo que queramos hacer con el resto de los valores asignados.
Por defecto es EncriptarCadenaOriginal Será la cadena a codificar o decodificar Clave Clave a usar para la codificación o decodificación RaiseError Si se debe producir un error al asignar una cadena vacía a cualquiera de las propiedades CadenaOriginal y/o Clave.
En el caso de Clave, si RaiseError es False, se asignará el valor por defecto.
Por defecto es TrueMétodos:
ConvertirClave Devuelve una cadena con la conversión hecha, codificada o decodificada, según los valores asignados a la propiedad Accion o bien porque se haya especificado el parámetro adecuado. Acepta tres parámetros, todos opcionales:
Cadena a codificar/decodificar
Clave a usar para la codificación/decodificación
Acción a realizar: codificar (encriptar) o decodificar (desencriptar)Encriptar Encripta la cadena indicada en CadenaOriginal con la Clave especificada. Acepta dos parámetros opcionales para la cadena y la clave
Desencriptar Lo contrario de Encriptar, también acepta dos parámetros opcionales. Nota: Tanto la acción de Encriptar como desencriptar son equivalentes, ya que dependiendo del estado de la cadena a encriptar y de la clave, así será lo que se haga...
Veamos ahora el código de la clase y después un ejemplo de cómo usarla.
Al final del todo está el link para el código de ejemplo en formato ZIP.cEncrypt.cls
' '------------------------------------------------------------------------------ ' cEncrypt (02/Jun/99) ' Clase para encriptar / desencriptar ' ' Basado en un código para MS-DOS del 26/Abr/1992 ' ' ©Guillermo 'guille' Som, 1992-99 '------------------------------------------------------------------------------ Option Explicit Public Enum eEncrypt eDesencriptar = 0 eEncriptar 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 Private Sub Class_Initialize() ' Por defecto devolver error m_RaiseError = True ' Clave por defecto m_sClave = mc_sClave ' Por defecto se encriptará m_Accion = eEncriptar End Sub Public Function ConvertirClave(Optional ByVal sOriginal As String = "", _ Optional ByVal sClave As String = "", _ Optional vAccion As Variant) As String '-------------------------------------------------------------------------- ' Convertir encriptado a variable normal o viceversa (20.11 26/Abr/92) ' Modificado en una sola 'función' ( 1.24 29/Abr/92) ' ' Adaptado a Visual Basic ( 4/Jul/98) ' Convertido en clase ( 2/Jun/99) ' ' ' Parámetros: ' sOriginal Texto a codificar/decodificar ' sClave Clave a usar para la codificación ' ' Se debe especificar la acción a tomar: ' vAccion Encriptar o Desencriptar ' ' ©Guillermo 'guille' Som, 1992-99 ' ' El algoritmo de encriptación es muy simple, pero... algo es algo ' Lo que se hace es: ' Tomar el valor Ascii del original, sumarselo al de la clave y ' crear un nuevo que será el que se use. ' Los valores de la clave van alternándose '-------------------------------------------------------------------------- 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 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
El formulario de prueba
El código de la prueba:
' '------------------------------------------------------------------------------ ' Prueba para usar la clase de encriptación (02/Jun/99) ' Basado en una prueba del 4/Jul/98 ' ' ©Guillermo 'guille' Som, 1998-99 '------------------------------------------------------------------------------ Option Explicit Private m_Encrypt As cEncrypt Private Sub chkModo_Click() If chkModo.Value = vbUnchecked Then cmdEncrypt.Caption = "Codificar" Else cmdEncrypt.Caption = "Decodificar" End If End Sub Private Sub cmdEncrypt_Click() ' Codificar / Decodificar Dim sResultado As String Dim bEncrypt As Boolean Dim sClavePrueba As String ' Si no se especifica la clave, usar este valor 'If Len(txtClave) = 0 Then ' txtClave = "Clave" 'End If ' Si se indica algo que encriptar/desencriptar If Len(Texto) Then ' Pruebas a realizar If Option1(1).Value Then sClavePrueba = Chr$(1) & Chr$(2) & Chr$(3) & Chr$(4) & Chr$(5) ElseIf Option1(2).Value Then sClavePrueba = Chr$(251) & Chr$(252) & Chr$(253) & Chr$(254) & Chr$(255) Else sClavePrueba = txtClave End If ' Si lo que queremos es encriptar o desencriptar bEncrypt = (chkModo.Value = vbUnchecked) ' Hacer la operación de encriptar/desencriptar sResultado = m_Encrypt.ConvertirClave(Texto, sClavePrueba, bEncrypt) ' También se puede usar así: 'With m_Encrypt ' .RaiseError = False ' .Accion = bEncrypt ' .CadenaOriginal = Texto ' .Clave = sClavePrueba ' sResultado = .ConvertirClave() 'End With txtInfo = txtInfo & sResultado & vbCrLf txtInfo.SelStart = Len(txtInfo.Text) ' Para poder cambiar el valor y volver a probar Texto = sResultado ' Invertir el estado de encriptar / desencriptar chkModo.Value = -1 * (bEncrypt) chkModo_Click Else Beep End If End Sub Private Sub Form_Load() ' Crear una nueva instancia de la clase Set m_Encrypt = New cEncrypt txtInfo = "" End Sub Private Sub Form_Unload(Cancel As Integer) ' Quitar la referencia de la memoria Set m_Encrypt = Nothing Set frmEncrypt = Nothing End Sub Private Sub Option1_Click(Index As Integer) If Index = 0 Then txtClave.Enabled = True Else txtClave.Enabled = False End If End SubPulsa aquí, si quieres bajarte el código de la clase y el ejemplo (gsEncrypt.zip 4.40 KB)