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 SubEste 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 SubA 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