Option Explicit
'Variables
'##################################################
' Estructura para dar de alta los datos de los clientes.
Private Type D_clientes
'Variables persona de contacto
nombre As String * 20
apellido1 As String * 20
apellido2 As String * 20
telefono As String * 20
movil As String * 20
fax As String * 20
email As String * 30
cargo As String * 15
'Variables empresa
empresa As String * 25
cif As String * 15
direccion As String * 25
NR As String * 5
puerta As String * 5
poligono As String * 25
localidad As String * 25
ciudad As String * 20
codpostal As String * 10
pais As String * 15
nrcliente As Integer
End Type
'Variables para utilizar la estructura anterior
Dim cliente As D_clientes
Dim clienteTemp As D_clientes
'Variables para el archivo de los datos de D_clientes 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 cliente
'Variables persona de contacto
.nombre = txt_nombre.Text
.apellido1 = txt_apellido1.Text
.apellido2 = txt_apellido2.Text
.telefono = txt_telefono.Text
.movil = txt_movil.Text
.fax = txt_fax.Text
.email = Trim(txt_email)
.cargo = txt_cargo.Text
'Variables empresa
.empresa = txt_empresa.Text
.cif = txt_cif.Text
.direccion = txt_direccion.Text
.NR = txt_NR.Text
.puerta = txt_puerta.Text
.poligono = txt_poligono.Text
.localidad = txt_localidad.Text
.ciudad = txt_ciudad.Text
.codpostal = txt_codpostal.Text
.pais = txt_pais.Text
.nrcliente = txt_nrcliente.Text
End With
'Escribimos los datos en el archivo y en la posición
Put #FileFree, RegActual, cliente
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, cliente
' Mostramos los datos en las cajas de texto
With cliente
'Variables persona de contacto
txt_nombre = Trim(.nombre)
txt_apellido1 = Trim(.apellido1)
txt_apellido2 = Trim(.apellido2)
txt_telefono = Trim(.telefono)
txt_movil = Trim(.movil)
txt_fax = Trim(.fax)
txt_email = Trim(.email)
txt_cargo = Trim(.cargo)
'Variables empresa
txt_empresa = Trim(.empresa)
txt_cif = Trim(.cif)
txt_direccion = Trim(.direccion)
txt_NR = Trim(.NR)
txt_puerta = Trim(.puerta)
txt_poligono = Trim(.poligono)
txt_localidad = Trim(.localidad)
txt_ciudad = Trim(.ciudad)
txt_codcodpostal = Trim(.codpostal)
txt_pais = Trim(.pais)
txt_nrcliente = .nrcliente
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
lbl_status.Caption = " Reg. Actual.:" & CStr(RegActual) & vbNewLine _
& "Total registros.:" & CStr(RegUltimo)
End Sub
'Botón que elimina un registro del archivo
'############################################
Private Sub cmd_eliminar_Click()
Pos = RegActual
If MsgBox(" Está seguro de eliminar el cliente ? ", vbYesNo) = vbNo Then
txt_empresa.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(clienteTemp)
RegActual = 1
RegActualTemp = 1
'Se recorren los registros del archivo
For p = 1 To RegUltimo - 1
Get #FileFree, RegActual, cliente
'Este es el registro que se elimina
If RegActualTemp = Pos Then
RegActual = RegActual + 1
End If
Get #FileFree, RegActual, cliente
With clienteTemp
'Variables persona de contacto
.nombre = Trim(cliente.nombre)
.apellido1 = Trim(cliente.apellido1)
.apellido2 = Trim(cliente.apellido2)
.telefono = Trim(cliente.telefono)
.movil = Trim(cliente.movil)
.fax = Trim(cliente.fax)
.email = Trim(cliente.email)
.cargo = Trim(cliente.cargo)
'Variables empresa
.empresa = Trim(cliente.empresa)
.cif = Trim(cliente.cif)
.direccion = Trim(cliente.direccion)
.NR = Trim(cliente.NR)
.puerta = Trim(cliente.puerta)
.poligono = Trim(cliente.poligono)
.localidad = Trim(cliente.localidad)
.ciudad = Trim(cliente.ciudad)
.codcodpostal = Trim(cliente.codpostal)
.pais = Trim(cliente.pais)
.nrcliente = cliente.nrcliente
End With
'Escribe en el archivo temporal los datos
Put #FileTemp, RegActualTemp, clienteTemp
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
'Botón que guarda un registro en el archivo
'############################################
Private Sub cmd_guardar_Click()
GuardarDatos
End Sub
'Botón para salir de la aplicación.
'############################################
Private Sub cmd_salir_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
cmb_buscar = cmb_buscar.List(0)
'Cargarcaptions
End Sub
Private Sub Cargar()
FileFree = FreeFile
Open "Datos.dat" For Random As FileFree Len = Len(cliente)
RegActual = 1
' Almacenamos la posición del último registro
RegUltimo = LOF(FileFree) / Len(cliente)
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 cmd_nuevo_click()
RegUltimo = RegUltimo + 1
'Limpia los datos de la estructura para poder agregar un nuevo registro
With cliente
'Variables persona de contacto
.nombre = ""
.apellido1 = ""
.apellido2 = ""
.telefono = ""
.movil = ""
.fax = ""
.email = ""
.cargo = ""
'Variables empresa
.empresa = ""
.cif = ""
.direccion = ""
.NR = ""
.puerta = ""
.poligono = ""
.localidad = ""
.ciudad = ""
.codcodpostal = ""
.pais = ""
.nrcliente = ""
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, cliente
RegActual = RegUltimo
VisualizarDatos
txt_empresa.SetFocus
End Sub
'Botón para Buscar datos
'##############################################
Private Sub cmd_buscar_click()
Dim Encontrado As Boolean, PosReg As Long, tmp As D_clientes
If txt_buscar = "" Then txt_empresa.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(txt_buscar) = 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: " & txt_buscar & " No se ha encontrado el registro"
End If
txt_empresa.SetFocus
End Sub
'Función que retorna el valor de la búsqueda
'#############################################
Private Function BuscarPor(t As D_clientes)
Select Case cmb_buscar.ListIndex
Case 0: BuscarPor = t.empresa
Case 1: BuscarPor = t.cif
Case 2: BuscarPor = t.nrcliente
End Select
End Function