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)
