Option Explicit


Sub cmdAccion_Click ()
    'Comprobar la etiqueta del volumen y mostrarla

    Dim i As Integer
    Dim sUd As String
    Dim sProg As String
    Dim sFic As String
    Dim sTmp As String
    Dim Hallado As Integer
    Dim sVolumen As String
    Dim sNumSerie As String

    Label1(3).Caption = "Procesando la información..."
    DoEvents

    sUd = Trim$(Text1.Text)
    i = InStr(sUd, ":")
    If i = 0 Then
        MsgBox "Debes especificar una unidad de disco."
        Unload Me
        End
    End If
    sUd = Left$(sUd, i)
    sFic = sUd & "\Files.txt"
    'Fichero para ejecutar el comando DIR
    sProg = sUd & "\~Files.bat"
    sUd = sUd & "\*.*"

    i = FreeFile
    Open sProg For Output As i
    Print #i, "Dir " & sUd & " >" & sFic
    Close i

    EjecutarPrograma sProg, "~Files"
    'Ya ha finalizado...
    'Abrir el archivo sFic
    '
    If Len(Dir$(sFic)) Then
        'Abrirlo
        i = FreeFile
        Open sFic For Input As i
        Do While Not EOF(i)
            Line Input #i, sTmp
            If InStr(sTmp, "volume") Then
                Hallado = True
                sVolumen = sTmp
                If Not EOF(i) Then
                    Line Input #i, sNumSerie
                End If
                Exit Do
            End If
        Loop
        Close i
        If Hallado Then
            'Obtener la etiqueta y el número de serie
            UltimaPalabra sVolumen
            UltimaPalabra sNumSerie
            If Len(sVolumen) = 0 Then
                sVolumen = "No tiene etiqueta de volumen?"
            End If
            If (Len(sNumSerie) = 0 Or InStr(sNumSerie, "-") = 0) Then
                sNumSerie = "No tiene número de serie?"
            End If
            Label1(3).Caption = sVolumen & " - " & sNumSerie
            Label2(0).Caption = sVolumen
            Label2(1).Caption = sNumSerie
        Else
            Label1(3).Caption = "No se encuentra la etiqueta del volumen..."
        End If
    Else
        MsgBox "No se ha podido crear el fichero: " & sFic
    End If
    'Borrar los archivos
    If Len(Dir$(sProg)) Then
        Kill sProg
    End If
    If Len(Dir$(sFic)) Then
        Kill sFic
    End If
    Text1.SetFocus
End Sub


Sub cmdSalir_Click ()
    Unload Me
    End
End Sub


Sub Form_Unload (Cancel As Integer)
    Set Form1 = Nothing
End Sub


Sub UltimaPalabra (sFrase As String)
    'De la cadena sFrase obtiene la última palabra
    'Realmente lo que haya desde el último espacio

    Dim i As Integer
    Dim sPalabra As String

    'Buscar el último espacio
    sPalabra = ""
    'Asegurarnos de no encontrar espacios al final de la cadena
    sFrase = Trim$(sFrase)
    For i = Len(sFrase) To 1 Step -1
        If Mid$(sFrase, i, 1) = " " Then
            sPalabra = Mid$(sFrase, i + 1)
            Exit For
        End If
    Next
    sFrase = Trim$(sPalabra)
End Sub