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
