Sección de código fuente Visual basic

Agenda con Archivos Aleatorios.

Agenda muy simple en Visual basic utilizando Ficheros de acceso aleatorio o también denominados Random , para almacenar los datos de los contactos de la Agenda.

Una vista del ejemplo:

vista previa del Formulario para crear la Agenda utilizando archivos de acceso Aleatorio

Para manipular los datos se utiliza una estructura o UDT que tiene las siguientes variables:

' Estructura para los datos de los contactos de la agenda Private Type Contacto Nombre As String * 40 Apellido As String * 50 Telefono As String * 40 Mail As String * 70 Nota As String * 250 End Type

Como se puede ver en la imagen, tiene una opción para buscar un registro y especificar por que campo buscar, ya sea por el nombre del contacto, el Apellido, el telefono o el correo electrónico.

Pasos a seguir para armar el formulario con los controles:

Agregar en un Formulario 6 controles TextBox con los siguiente nombres:

txtNombre
txtApellido
txtTelefono
txtMail
txtNota
txtBuscar

Luego agregar 7 CommandButton con los siguientes nombres:

CmdAnterior : Botón para ir al anterior registro
cmdSiguiente : Botón para ir al siguiente registro
cmdGuardar : Botón para guardar los cambios cuando se seleccionó previamente la opción Nuevo Registro
cmdEliminar: Elimina el registro actual
cmdNuevo : Añade un nuevo reg
cmdBuscar : Para buscar
Cmdsalir : Descarga el Form

Ahora, agregar un control ComboBox llamado Combo1. A este combo, establecerle en la propiedad Style el valor 2 ( DropDownList ) y agregarle los siguientes valores en la propiedad List: Nombre, Apellido, Telefono e Mail en ese orden

Nota: Para agregar datos en la propiedad List desde la ventana de propiedades, debes mantener la tecla Ctrl presionada y presionar la tecla Enter para añadir un nuevo dato o Item.

Por último, agregar un control Label llamado lblStatus que servirá para poder mostrar cuando nos desplazamos por los registros, con los botones anterior y siguiente, el número del registro actual y la cantidad de registros que hay en el archivo. Este Label lo puedes situar en la parte inferior del formulario o donde quieras.

Colocar el código fuente en el formulario:

Option Explicit 'Variables '################################################## ' Estructura para los datos de los contactos de la agenda Private Type Contacto Nombre As String * 40 Apellido As String * 50 Telefono As String * 40 Mail As String * 70 Nota As String * 250 End Type 'Variables para utilizar la estructura anterior Dim Datos As Contacto Dim DatosTemp As Contacto 'Variables para el archivo de los datos de contacto y temporal Dim FileFree As Integer Dim FileTemp As Integer 'Variables para la posición del primer y último registro Dim RegActual As Long Dim RegUltimo As Long ' Variable para la posición Temporal del registro Dim RegActualTemp As Long Dim Pos As Integer, p As Integer '###################################################### 'Funciones y procedimientos '###################################################### ' Subrutina que guarda los datos en el archivo '############################################# Private Sub GuardarDatos() 'Asignamos los datos de la estructura con el contenido de los textBox With Datos .Nombre = txtNombre.Text .Apellido = txtApellido .Telefono = txtTelefono.Text .Nota = txtNota.Text .Mail = Trim(txtMail) End With 'Escribimos los datos en el archivo y en la posición Put #FileFree, RegActual, Datos End Sub ' Subrutina que Visualiza los datos en los textBox '################################################## Private Sub VisualizarDatos() 'Lee del fichero en el registro posicionado y almacena los datos_ _ en la la variable UDT Get #FileFree, RegActual, Datos ' Mostramos los datos en las cajas de texto With Datos txtApellido = Trim(.Apellido) txtNombre = Trim(.Nombre) txtTelefono = Trim(.Telefono) txtMail = Trim(.Mail) txtNota.Text = Trim(.Nota) End With 'Mostramos en el control Label la posición del registro actual _ y la cantidad o Total de registros que hay en el archivo lblStatus.Caption = "Registro Actual: " & CStr(RegActual) & vbNewLine _ & " Total de registros: " & CStr(RegUltimo) End Sub 'Botón que elimina un registro del archivo '############################################ Private Sub cmdEliminar_Click() Pos = RegActual If MsgBox(" Está seguro de eliminar el contacto ? ", vbYesNo) = vbNo Then txtNombre.SetFocus Exit Sub End If ' Verificamos que el archivo temporal no exista, si existe se elimina If Dir("Temporal.tmp") = "Temporal.tmp" Then Kill "Temporal.tmp" End If FileTemp = FreeFile 'Abrimos y creamos un nuevo fichero temporal Open "Temporal.tmp" For Random As FileTemp Len = Len(DatosTemp) RegActual = 1 RegActualTemp = 1 'Se recorren los registros del archivo For p = 1 To RegUltimo - 1 Get #FileFree, RegActual, Datos 'Este es el registro que se elimina If RegActualTemp = Pos Then RegActual = RegActual + 1 End If Get #FileFree, RegActual, Datos With DatosTemp .Apellido = Trim(Datos.Apellido) .Nombre = Trim(Datos.Nombre) .Telefono = Trim(Datos.Telefono) .Mail = Trim(Datos.Mail) .Nota = Trim(Datos.Nota) End With 'Escribe en el archivo temporal los datos Put #FileTemp, RegActualTemp, DatosTemp RegActual = RegActual + 1 RegActualTemp = RegActualTemp + 1 Next Close FileFree 'Elimina el archjivo con los datos Kill "Datos.dat" Close FileTemp 'Renombra el archivo temporal a datos.dat Name "Temporal.tmp" As "Datos.dat" ' Mostramo los datos en los textbox Cargar RegActual = Pos VisualizarDatos End Sub Private Sub cmdGuardar_Click() GuardarDatos End Sub Private Sub Cmdsalir_Click() 'Guarda los cambios en el archivo antes de salir GuardarDatos 'cierra el archivo abierto Close #FileFree End End Sub Private Sub form_load() 'Carga el primer registro del archivo Cargar 'Selecciona en el combo para la búsqueda de datos Combo1 = Combo1.List(0) Cargarcaptions End Sub Private Sub Cargar() FileFree = FreeFile Open "Datos.dat" For Random As FileFree Len = Len(Datos) RegActual = 1 ' Almacenamos la posición del último registro RegUltimo = LOF(FileFree) / Len(Datos) If RegUltimo = 0 Then RegUltimo = 1 End If 'Cargamos los datos en los Textbox VisualizarDatos End Sub 'Botón que agrega un nuevo registro '##################################### Private Sub cmdNuevo_click() RegUltimo = RegUltimo + 1 'Limpia los datos de la estructura para poder agregar un nuevo registro With Datos .Apellido = "" .Nombre = "" .Telefono = "" .Mail = "" .Nota = "" End With ' Graba datos vacios en el nuevo registro hasta que se presione el botón _ Guardar que graba los verdaderos datos Put #FileFree, RegUltimo, Datos RegActual = RegUltimo VisualizarDatos txtNombre.SetFocus End Sub 'Botón para posicionar en el siguiente registro '############################################## Private Sub cmdSiguiente_click() If RegActual = RegUltimo Then MsgBox " Ultimo registro ", vbInformation Else 'Incrementa la posición RegActual = RegActual + 1 'Cargamos los datos en el textbox del siguiente registro VisualizarDatos End If txtNombre.SetFocus End Sub 'Botón para posicionar en el Anterior registro '############################################## Private Sub CmdAnterior_click() If RegActual = 1 Then MsgBox " Primer registro ", vbInformation Else 'Decrementamos la variable que mantiene la posición del registro actual RegActual = RegActual - 1 'Mostramos los datos en las cajas de texto VisualizarDatos End If txtNombre.SetFocus End Sub 'Botón para Buscar datos '############################################## Private Sub cmdBuscar_click() Dim Encontrado As Boolean, PosReg As Long, tmp As Contacto If txtBuscar = "" Then txtNombre.SetFocus: Exit Sub Encontrado = False 'Recorremos desde el primer hasta el último en busca del registro a buscar For PosReg = 1 To RegUltimo 'Leemos el registro Get #FileFree, PosReg, tmp 'Si es el dato es igual salimos del bucle If UCase(txtBuscar) = UCase(Trim(BuscarPor(tmp))) Then Encontrado = True Exit For End If Next If Encontrado Then RegActual = PosReg 'Cargamos los datos en los text VisualizarDatos Else MsgBox "Nombre: " & txtBuscar & " No se ha encontrado el registro" End If txtNombre.SetFocus End Sub 'Función que retorna el valor de la búsqueda '############################################# Private Function BuscarPor(t As Contacto) Select Case Combo1.ListIndex Case 0: BuscarPor = t.Nombre Case 1: BuscarPor = t.Apellido Case 2: BuscarPor = t.Telefono Case 3: BuscarPor = t.Mail End Select End Function ' Establece los captions de los controles Command del formulario Private Sub Cargarcaptions() Me.Caption = " Agenda simple utilizando archivos aleatorios " CmdAnterior.Caption = " Anterior " cmdSiguiente.Caption = " Siguiente " cmdGuardar.Caption = " Guardar " cmdEliminar.Caption = " Eliminar " cmdNuevo.Caption = " Nuevo " cmdBuscar.Caption = " Buscar " Cmdsalir.Caption = " Salir " End Sub

Nota: Si se desea agregar mas opciones, como por ejemplo el Domicilio, Pais, o cualquier otro dato, solo hay que modificar el estructura Datos y obviamente cambiar en todos los procedimientos donde se asignan y leen valores los nuevos que se han agregado.

Buscar en Recursos vb