Agenda con archivos aleatorios

Responder
Avatar de Usuario
Grendal
Administrador
Mensajes: 97
kuchnie na wymiar Ruda Śląska Rybnik Tychy
Registrado: Mié Abr 08, 2020 1:05 am

Agenda con archivos aleatorios

Mensaje por Grendal »

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:

Imagen

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

Código: Seleccionar todo

' 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, colocarle 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.

Código: Seleccionar todo

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, País, 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.

FlaviusTitus
Novato
Mensajes: 1
Registrado: Lun Abr 13, 2020 4:38 pm

Re: Agenda con archivos aleatorios

Mensaje por FlaviusTitus »

Cuando tenía 11 años hice una agenda en Qbasic con archivos de acceso aleatorio. Había visto parte del código en una revista llamada PC users. jejeje! Que lindos recuerdos!

Responder