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. |
| CadenaOriginal | 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 True |
M�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: |
| 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 Sub
Pulsa aqu�, si quieres bajarte el c�digo de la clase y el ejemplo (gsEncrypt.zip 4.40 KB)
