Sección de códigos , trucos y ejemplos para visual basic

293 - Encriptar y desencriptar datos de una base de datos Access

Ejemplo que usa un simple algorítmo para encriptar un dato al añadir un nuevo registro, y luego lo desencripta al leerlo

El ejemplo es como muestra el siguiente form:

vista del formulario de ejemplo para guardar datos encriptados en una base access

es decir, es un fromulario que muestra dos campos ( campo " Nombre " y campo " Apellido ").

El campo Apellido es el que se encripta en la bd

Al leer desde el recordset el campo que está encriptado, se llama a una función llamada Codificar

En el primer parámetro de la función Codificar, se debe indicar el dato. El segundo parámetro indica la acción ( Encriptar o desencriptar )

Por ejemplo para encripar el dato y guardarlo en la base de datos

Recordset.Fields("ElCampo") = Codificar(ElValor, ENCRIPTAR)

... para desencriptar el dato y mostrarlo en un textBox:

Text1.Text = Codificar(Rst.Fields(" El Campo encriptado "), DESENCRIPTAR)

Ejemplo

Crear una base de datos Access vacía ( sin ningún registro ) con dos campos, uno llamado nombre y otro Apellido. El campo Apellido es el que se encripta.

La base de datos dejarla con el nombre bd1.mdb . A la tabla llamarla Usuarios

Al formulario agregarle dos textox, uno llamado txtNombre y al otro txtApellido

Añadir tres commandbutton: CmdAnterior, cmdSiguiente y cmdNuevo

Añadir un módulo bas para colocar la función que codifica

Por último agregar la referencia a Microsoft Activex data Objects para poder usar Ado

Código fuente en el formulario

Option Explicit ' Variable para el recordset Dim Rst As Recordset ' Anterior registro Private Sub cmdAnterior_Click() If Not (Rst.BOF Or Rst.EOF) Then Rst.MovePrevious Call Mostrar_Datos(Rst) End If End Sub ' Siguiente Registro Private Sub cmdSiguiente_Click() If Not Rst.EOF Then Rst.MoveNext Call Mostrar_Datos(Rst) End If End Sub Private Sub CmdNuevo_Click() Dim Nombre As String Dim Apellido As String ' Para el nombre Do Nombre = InputBox(" Nombre del usuario ", " Nuevo registro ") Loop Until Nombre <> vbNullString ' PAra el apellido ( Dato para encriptar ) Do Apellido = InputBox("ESTE DATO ES EL QUE SE ENCRIPTA ", "Escribir Apellido") Loop Until Apellido <> vbNullString ' Nuevo registro Rst.AddNew ' graba el nombre Rst("Nombre") = Nombre ' Encripta el dato y lo guarda en el campo "Apellido" Rst("Apellido") = Codificar(Apellido, ENCRIPTAR) 'Actualiza Rst.Update ' Visualiza los datos en los textbox Call Mostrar_Datos(Rst) End Sub ' Muestra los datos en los textbox Sub Mostrar_Datos(Rst As Recordset) ' si no hay registro activo sale If Rst.EOF And Rst.BOF Then Exit Sub If Rst.EOF Then Rst.MoveLast End If If Rst.BOF Then Rst.MoveFirst End If ' Muestra el dato del campo "Nombre" txtNombre.Text = Rst.Fields("Nombre") ' Desencripta el dato del campo Apellido y lo carga en el textbox txtApellido.Text = Codificar(Rst.Fields("Apellido"), DESENCRIPTAR) End Sub Private Sub Form_Load() Dim Path_bd As String Dim db As Connection Set db = New Connection db.CursorLocation = adUseClient Path_bd = App.Path & "\bd1.mdb" ' Abre la base de datos db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & Path_bd & ";" ' Nuevo recordset Set Rst = New Recordset Rst.Open "select * from usuarios", db, adOpenStatic, adLockOptimistic txtNombre.Text = "" txtApellido.Text = "" If Not (Rst.BOF And Rst.EOF) Then ' Carga los datos en los textbox Call Mostrar_Datos(Rst) End If End Sub ' Descarga el recordset Private Sub Form_Unload(Cancel As Integer) If Not Rst.State = adStateClosed Then Rst.Close End If If Not Rst Is Nothing Then Set Rst = Nothing End If End Sub

Código en un módulo bas

Option Explicit Enum E_Accion ENCRIPTAR = 0 DESENCRIPTAR = 1 End Enum ' Función para encriptar y desencriptar el valor Function Codificar(Valor As Variant, Accion As E_Accion) As Variant Dim i As Long Select Case Accion Case 0 For i = 1 To Len(Trim(Valor)) Mid(Valor, i, 1) = Chr(Asc(Mid(Valor, i, 1)) - 1) Next Case 1 For i = 1 To Len(Trim(Valor)) Mid(Valor, i, 1) = Chr(Asc(Mid(Valor, i, 1)) + 1) Next End Select Codificar = Valor End Function

Nota: en este enlace hay un algorítmo para encriptar y desencriptar cadenas realizado por Harvey Triana

Función para encriptar y desencriptar cadenas de caracteres

Buscar en Recursos vb