Ahora s� que est� la soluci�n de la entrega 19, la verdad es que si no lo has conseguido, no debes preocuparte demasiado, no era tan "simple" como podr�a parecer, ya que se necesita de un poco de "tablas" y manejo en esto de la programaci�n, as� que si est�s dispuesto a ser sincero, por favor env�ame un mensaje diciendo si lo conseguiste o no, esto me ayudar� a saber si tengo que poner cosas m�s sencillas o dedicarme a ense�ar otras cosillas, no s�..., por ejemplo porqu� cuando todo est� oscuro no se ve nada... je.
Para volver a la entrega 19, pulsa en este link.
Este es el listado completo de la soluci�n que YO he encontrado al ejercicio, por supuesto no tiene porqu� ser igual a la tuya, si quieres puedes mandarme una copia del resultado que has encontrado... no te garantizo nada, pero lo mismo hasta te comento sobre �l... Venga, ��nimo! que lo dif�cil a�n no ha empezado... ;-)
Esta es una foto del programa en ejecuci�n y el listado del mismo:
'------------------------------------------------------------------
'Ejercicio para la entrega 19 (24/Jun/98)
'(soluci�n)
'
'�Guillermo 'guille' Som, 1998
'------------------------------------------------------------------
Option Explicit
Private Sub Form_Load()
Dim i As Integer
'Para probar uso el fichero de colegas.dat
'el tama�o de cada campo era: 30, 2, 50
'Private Type t_Colega
' Nombre As String * 30
' Edad As Integer
' email As String * 50
'End Type
'
txtOrigen = "colegas.dat"
'Crear los controles de destino
'(empezamos por UNO porque el control CERO ya est� creado)
For i = 1 To 9
'Cargarlos en memoria
Load lblDest(i)
Load txtDestTam(i)
'Asignarles la posici�n y hacerlos visible
With txtDestTam(i)
.Visible = True
.Top = txtDestTam(i - 1).Top + .Height + 45
lblDest(i).Top = .Top - 15
lblDest(i).Visible = True
lblDest(i) = "Campo " & i + 1 & ":"
'Ajustar el TabIndex,
'(se supone que ya estaban por orden)
lblDest(i).TabIndex = txtDestTam(i - 1).TabIndex + 1
.TabIndex = lblDest(i).TabIndex + 1
End With
Next
'Borrar el contenido de los TextBoxes
For i = 0 To 9
txtTam(i).Text = ""
txtDestTam(i).Text = ""
Next
End Sub
Private Sub cmdConvertir_Click()
'Variables para los nombres y n�meros de ficheros
Dim nFic As Long, nFic2 As Long
Dim sFic As String, sFic2 As String
'Estos arrays controlar�n los tama�os de cada campo
Dim aOrigen() As Long
Dim aDestino() As Long
'N�mero de campos en cada fichero
Dim nOrigen As Integer
Dim nDestino As Integer
'Tama�os de los registros
Dim tOrigen As Integer
Dim tDestino As Integer
'Las cadenas que contendr�n los datos
Dim sOrigen As String
Dim sDestino As String
'N�mero de registros del fichero de origen
Dim numReg As Integer
Dim tamFic As Long
'Para usos generales
Dim i As Long, j As Long
Dim posReg As Long
Dim sTmp As String
'Antes de hacer nada, comprobamos que exista el fichero
'de origen
sFic = Trim$(txtOrigen)
If Len(Dir$(sFic)) = 0 Then
MsgBox "�ATENCI�N! No existe el fichero de origen."
txtOrigen.SetFocus
Exit Sub
End If
'Asignamos el nombre del fichero de destino
sFic2 = Trim$(txtDestino)
'Se asignar�n los tama�os de cada registro, se dejar�
'de comprobar cuando el contenido del textbox sea cero.
'Si se usara un TextBox con el n�mero de campos, la cosa
'ser�a m�s f�cil de controlar, pero...
'
'Empezamos por el origen
For i = 0 To 9
If Val(txtTam(i)) = 0 Then
'ya no hay nada m�s que comprobar
Exit For
Else
nOrigen = nOrigen + 1
ReDim Preserve aOrigen(nOrigen)
'asignamos el tama�o del campo nOrigen
aOrigen(nOrigen) = Val(txtTam(i))
'ajustamos el tama�o total del registro
tOrigen = tOrigen + aOrigen(nOrigen)
End If
Next
'Ahora comprobamos el destino
For i = 0 To 9
If Val(txtDestTam(i)) = 0 Then
'ya no hay nada m�s que comprobar
Exit For
Else
nDestino = nDestino + 1
ReDim Preserve aDestino(nDestino)
'asignamos el tama�o del campo nDestino
aDestino(nDestino) = Val(txtDestTam(i))
'ajustamos el tama�o total del registro
tDestino = tDestino + aDestino(nDestino)
End If
Next
'
'Ya tenemos la informaci�n suficiente,
'
'Por si da error al acceder a los ficheros
On Local Error GoTo ErrorConvertir
'Abrimos los ficheros en modo binario
nFic = FreeFile
Open sFic For Binary As nFic
'Averiguar el n�mero de registros de este fichero
tamFic = LOF(nFic)
numReg = tamFic \ tOrigen
'Comprobar que el tama�o especificado concuerda con el fichero
'Si el n�mero de registros multiplicado por el tama�o de cada
'registro es diferente al tama�o del fichero...
If numReg * tOrigen <> tamFic Then
MsgBox "Los tama�os especificados en los campos de origen" & vbCrLf & _
"no concuerdan con el tama�o del fichero.", vbCritical, "Convertir ficheros"
Close
txtTam(0).SetFocus
Exit Sub
End If
'Abrimos el fichero de destino
nFic2 = FreeFile
Open sFic2 For Binary As nFic2
'
'Preparamos la cadena que contendr� los datos de origen
'esta no cambiar� de tama�o
sOrigen = Space$(tOrigen)
'Hacemos un bucle para todos los registros de origen
For j = 1 To numReg
Get nFic, , sOrigen
'La cadena de destino se formar� con el tama�o de
'los campos de origen m�s el tama�o de los nuevos campos,
'si el n�mero de campos de destino es diferente,
'simplemente se rellenar� la cadena con espacios
sDestino = ""
'
'Esta variable contendr� la posici�n dentro del registro
'del campo que se est� procesando
posReg = 1
For i = 1 To nOrigen
'Tomamos el contenido del campo actual
sTmp = Mid$(sOrigen, posReg, aOrigen(i))
'Asignamos este campo y lo rellenamos de espacios
sTmp = Left$(sTmp & Space$(aDestino(i)), aDestino(i))
sDestino = sDestino & sTmp
'ajustamos el tama�o de la posici�n dentro del registro
'de origen
posReg = posReg + aOrigen(i)
Next
'Ahora hay que rellenar la cadena de destino con espacios
'suficientes hasta completar el n�mero de caracteres
'que se han especificado.
'
'El TRUCO est� en a�adirle a la cadena de destino la
'cantidad de caracteres totales y s�lo quedarnos
'con esa cantidad, de esta forma nos aseguramos que
'tendremos la cantidad que necesitamos tener...
'
sDestino = Left$(sDestino & Space$(tDestino), tDestino)
'Lo guardamos
Put nFic2, , sDestino
Next
'Se acab� de convertir, cerramos los ficheros
Close
'Guardamos la informaci�n de los formatos usados:
'
'Uso un formato standard INI para que se pueda leer de forma
'f�cil, incluso usando el ejemplo de la entrega 20
'
nFic = FreeFile
Open "Convertir.ini" For Output As nFic
'Datos de origen:
Print #nFic, "[Datos de Origen]"
Print #nFic, "Fichero=" & sFic
Print #nFic, "N�mero de campos=" & nOrigen
For i = 1 To nOrigen
Print #nFic, "Tama�o Campo" & CStr(i) & "=" & aOrigen(i)
Next
Print #nFic, ""
'Datos de destino:
Print #nFic, "[Datos de Destino]"
Print #nFic, "Fichero=" & sFic2
Print #nFic, "N�mero de campos=" & nDestino
For i = 1 To nDestino
Print #nFic, "Tama�o Campo" & CStr(i) & "=" & aDestino(i)
Next
Close
'Avisamos de que todo acab� bien
MsgBox "Se ha convertido el fichero de forma satisfactoria," & vbCrLf & _
"La informaci�n de los datos convertidos est� en: Convertir.ini", _
vbInformation, "Convertir ficheros."
SalirConvertir:
Close
Exit Sub
ErrorConvertir:
MsgBox "Se ha producido el siguiente error:" & vbCrLf & _
Err.Number & " " & Err.Description, vbCritical, "Convertir ficheros"
Resume SalirConvertir
End Sub
El contenido del fichero "Convertir.ini" de la prueba que he hecho, ser�a el siguiente:
[Datos de Origen] Fichero=colegas.dat N�mero de campos=3 Tama�o Campo1=30 Tama�o Campo2=2 Tama�o Campo3=50 [Datos de Destino] Fichero=colegas2.dat N�mero de campos=4 Tama�o Campo1=40 Tama�o Campo2=2 Tama�o Campo3=50 Tama�o Campo4=128
Nos vemos.
Guillermo
Si quieres los listados del programilla, para verlo m�s c�modamente, los puedes bajar pulsando en este link.
