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)