Lección 19

'------------------------------------------------------------------
'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

[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