Curso Básico de Programación
en Visual Basic

Soluciones de la entrega Dieciocho.
Fecha: 26/Abr/98

 

Vamos a ver las soluciones a los ejercicios de la entrega dieciocho:
El primero era crear una utilidad para convertir un fichero de un tipo a otro. Una solución sería esta:

Private Type t_Colega
    Nombre As String * 30
    Edad As Integer
    email As String * 50
End Type

Private Type t_Colega2
    Nombre As String * 30
    Edad As Integer
    email As String * 50
    URL As String * 128
End Type


Private Sub cmdConvertir_Click()
    Dim unColega As t_Colega, unColega2 As t_Colega2
    Dim nFic As Long, nFic2 As Long
    Dim numColegas As Long
    Dim i As Long

    'abrir el fichero original
    nFic = FreeFile
    Open "colegas.dat" For Random As nFic Len = Len(unColega)

    'abrir el fichero de destino
    nFic2 = FreeFile
    Open "colegas2.dat" For Random As nFic2 Len = Len(unColega2)

    numColegas = LOF(nFic) \ Len(unColega)

    For i = 1 To numColegas
        'leer el registro
        Get #nFic, i, unColega
        'Asignar los nombres del nuevo tipo
        With unColega
            unColega2.Nombre = .Nombre
            unColega2.Edad = .Edad
            unColega2.email = .email
            unColega2.URL = ""
        End With
        'Guardar el nuevo registro
        Put #nFic2, i, unColega2
    Next

    Close nFic2
    Close nFic

    'Si quieres eliminar el fichero anterior y cambiarle el nombre
    'hazlo después de cerrar los ficheros

End Sub

Este es el listado completo del segundo ejercicio:

'------------------------------------------------------------------
'Ejercicio de la entrega 18                             (26/Abr/98)
'
'©Guillermo 'guille' Som, 1998
'------------------------------------------------------------------
Option Explicit

'Tipo para usar en el fichero
Private Type t_Colega
    Nombre As String * 30
    Edad As Integer
    email As String * 50
End Type

'Esta variable se usará para acceder a los datos
Dim m_unColega As t_Colega
'Número de registros del fichero
Dim m_numColegas As Long
'Número del colega actual, usado cuando se edita, etc.
Dim m_elColega As Long
'Esta variable guardará el fichero a usar
Dim m_sFicColegas As String
'Esta se usará como FLAG para saber si hemos cambiado
'el registro actual
Dim m_Modificado As Boolean


Private Sub cmdGuardar_Click()
    Dim nFic As Long

    'Sólo si el número del colega es el indicado en Text4
    'de esta forma sólo se guardará cuando se pulse en
    'Nuevo o en Leer
    If m_elColega = Val(Text4) Then
        nFic = FreeFile
        Open m_sFicColegas For Random As nFic Len = Len(m_unColega)

        With m_unColega
            .Nombre = Text1
            .Edad = Val(Text2)
            .email = Text3
        End With

        'Guardar los datos en el disco
        Put #nFic, m_elColega, m_unColega
        Close nFic
        'Ajustar el número de colegas
        m_numColegas = CuantosColegas()

        m_Modificado = False

        'Posicionar el cursor en el número de registro
        Text4.SetFocus
    End If
End Sub


Private Sub cmdLeer_Click()
    Dim nFic As Long

    'No se comprueba si se ha modificado el registro actual
    'esto habría que tenerlo en cuenta... lo he dejado preparado
    'con la variable m_Modificado
    'Te dejo que hagas las comparaciones pertinentes...
    '...

    'Sólo leer si no se está añadiendo uno nuevo
    If m_elColega <= m_numColegas Then
        m_elColega = Val(Text4)

        'Pero que no se lea un valor "no válido"
        If m_elColega > 0 And m_elColega <= m_numColegas Then
            nFic = FreeFile
            Open m_sFicColegas For Random As nFic Len = Len(m_unColega)

            'leer ese registro
            Get #nFic, m_elColega, m_unColega

            'quitarle los espacios "extras", ya que al ser
            'de longitud fija, los espacios en blanco también
            'se mostrarán en la caja de texto
            'Para comprobarlo, quita el Trim$ y verás lo que
            'ocurre cuando el nombre tiene menos caracteres...
            With m_unColega
                Text1 = Trim$(.Nombre)
                Text2 = .Edad
                Text3 = Trim$(.email)
            End With

            Close nFic
            m_Modificado = False

            Text1.SetFocus
        Else
            'si el número no es válido...
            Text4.SetFocus
            m_elColega = 0
        End If
    End If
End Sub


Private Sub cmdNuevo_Click()
    '¿Comprobar si se ha modificado?
    '...

    'Añadir un nuevo colega,
    'sólo si no se está introduciendo uno nuevo
    If m_elColega <> m_numColegas + 1 Then
        m_elColega = m_numColegas + 1
        Text4 = m_elColega

        'Limpiar el contenido de las cajas de texto
        Text1 = ""
        Text2 = ""
        Text3 = ""

        'Limpiar también la variable el registro actual,
        'aunque realmente no es necesario...
        With m_unColega
            .Nombre = ""
            .Edad = 0
            .email = ""
        End With

        m_Modificado = False
        'Posicionar el cursor en el campo del nombre
        Text1.SetFocus
    End If
End Sub


Private Sub Form_Load()
    'asignamos el path del fichero de colegas:
    m_sFicColegas = App.Path & "\Colegas.dat"
    'Esta asignación fallará si el path es el directorio raiz
    'por tanto se debería comprobar de esta forma:
    If Right$(App.Path, 1) = "\" Then
        m_sFicColegas = App.Path & "Colegas.dat"
    Else
        m_sFicColegas = App.Path & "\Colegas.dat"
    End If
    'También de esta otra forma... algo menos "clara"
    m_sFicColegas = App.Path & _
                    IIf(Right$(App.Path, 1) = "\", "", "\") & _
                    "Colegas.dat"

    'Inicialmente leer el número de registros
    'lo pongo en una función para usarlo cuando se necesite,
    'sin tener que repetir el proceso, aunque corto, pero...
    m_numColegas = CuantosColegas()

    'Borrar el contenido de los TextBox
    Text1 = ""
    Text2 = ""
    Text3 = ""
    Text4 = ""

    'Para empezar no se ha modificado
    m_Modificado = False
End Sub


Private Function CuantosColegas() As Long
    'Esta función se encarga de informarnos del número de registros
    'que tiene el fichero
    'Usarlo sólo cuando queremos saber esta información y
    'no necesitamos mantener el fichero abierto

    'si no existe el fichero, se producirá un error
    On Local Error Resume Next

    CuantosColegas = FileLen(m_sFicColegas) \ Len(m_unColega)
    If Err Then
        CuantosColegas = 0
    End If

    Label1(4) = "Número de colegas:" & CuantosColegas
    Err = 0
End Function


Private Sub Form_Unload(Cancel As Integer)
    'Por si se quedó o estaba el fichero abierto...
    Close

    Set Form1 = Nothing
End Sub


Private Sub Text1_Change()
    'Si en lugar de usar tres TextBox distintos se usara un array
    'sería más cómodo, ya que sólo se pondrá esta asignación
    'en un sólo evento Change.
    '
    m_Modificado = True
End Sub

Private Sub Text2_Change()
    m_Modificado = True
End Sub

Private Sub Text3_Change()
    m_Modificado = True
End Sub
 

A ver si la próxima entrega no se hace de rogar demasiado, que ya estamos casi a punto de acabar con esto del acceso a los ficheros...

Nos vemos.
Guillermo


 

entrega anterior

Ir al índice principal del Guille