Conoscere la durata di un file Midi con le sole risorse di Gambas
Da Gambas-it.org - Wikipedia.
Versione del 23 ago 2015 alle 08:55 di Vuott (Discussione | contributi)
Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente, nel quale si otterranno anche le durate delle singole tracce MTrk presenti nel file ed alcune generiche informazioni:
Private fl As File
Private file_offset As Integer
Private bpm$ As String
Public Sub Main()
Dim fileMidi, s As String
Dim durata_Midi As Float
fileMidi = "/percorso/del/file.mid"
Print "File Midi:";; fileMidi
Print "Dimensione:";; Stat(fileMidi).Size;; "byte"
fl = Open fileMidi For Read
If IsNull(fl) Then Error.Raise("Impossibile aprire il file !")
Read #fl, s, 4
If s <> "MThd" Then Error.Raise("Il file non è uno standard Midi !")
durata_Midi = legge_smf()
Print "\n\n DURATA del FILE MIDI: "; Date(0, 0, 0, 0, 0, 0, durata_Midi * 1000)
End
Private Function legge_smf() As Float ' Legge l'intero file Midi
Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer
Dim num_tracce As Short
Dim err, traccia As Byte
Dim s As String
Dim dur, superior As Float
' La corrente posizione all'interno del file è immediatamente dopo "Mthd":
lung_MThd = legge_dal_file(4)
If lung_MThd <> 6 Then Error.Raise("Formato di file non valido !")
tipo = legge_dal_file(2)
If (tipo <> 0) And (tipo <> 1) Then Error.Raise("Il tipo " & tipo & " non è supportato !")
Print "Tipo file Midi:";; tipo
num_tracce = legge_dal_file(2)
If (num_tracce < 1) Or (num_tracce > 1000) Then Error.Raise(num_tracce & ": è un numero di tracce non valido !")
Print "Numero totale Tracce:";; num_tracce
risoluzione_TD = legge_dal_file(2)
If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !")
Print "Risoluzione Tempo Delta:";; risoluzione_TD
Print "\n\n=== DURATA delle";; num_tracce;; "TRACCE ===\n"
' Legge le tracce MTrk del file Midi:
For traccia = 1 To num_tracce
' Cerca il blocco "Mtrk" della traccia corrente:
For err = 0 To 1
Read #fl, s, 4
lenI = legge_dal_file(4)
If Eof(fl) Then Error.Raise("Inattesa fine del file !")
If (lenI < 0) Or (lenI >= 268435456) Then Error.Raise(CStr(lenI) & ": lunghezza del blocco traccia non valido !")
If s = "MTrk" Then Exit
Next
file_offset = Seek(fl)
dur = legge_traccia(CStr(traccia), file_offset + lenI, risoluzione_TD)
superior = Max(dur, superior)
Next
Return superior
End
Private Function legge_traccia(nmt As String, fine_traccia As Integer, rTD As Integer) As Float ' Legge una intera singola traccia Mtrk
Dim tick, delta_ticks, lenI, totale_tick_traccia As Integer
Dim c, ultimo_cmd, cmd, tipo_cmd As Byte
Dim f As Float
Dim tempus, t1 As String
' L'attuale posizione del puntatore nel file Midi è dopo i byte di identificazione e di lunghezza della traccia:
While file_offset < fine_traccia
delta_ticks = legge_var()
If delta_ticks < 0 Then Break
tick += delta_ticks
Read #fl, c
file_offset += 1
If c < 0 Then Break
If c And 128 Then
cmd = c
If cmd < 240 Then ultimo_cmd = cmd
Else
' Status Running:
Read #fl, c
Dec file_offset
cmd = ultimo_cmd
If Not cmd Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
Endif
tipo_cmd = cmd \ CInt(2 ^ 4)
Select Case tipo_cmd
Case 8 To 11
legge_byte()
legge_byte()
Case 14
legge_byte()
legge_byte()
Case 12 To 13
legge_byte()
Case 15
Select Case cmd
Case 240, 247
lenI = legge_var()
If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
If cmd = 240 Then
Inc lenI
c = 1
Else
c = 1
Endif
For c = 0 To lenI - 1
legge_byte()
Next
Break
Case 255 ' Meta-evento
c = legge_byte()
lenI = legge_var()
If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
Select Case c
Case 33
If lenI < 1 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
legge_byte()
salto(lenI - 1)
Case 47 ' Fine traccia
totale_tick_traccia = tick
If nmt = "1" Then t1 = " (del Tempo)"
f = (((60000000 / Fix(60000000 / Val("&" & bpm$))) / rTD) * totale_tick_traccia) / 1000000
If f > 0 Then tempus = Str(Date(0, 0, 0, 0, 0, 0, f * 1000))
If IsNull(tempus) Then tempus = "00:00:00"
Print "Traccia";; nmt; ": "; " "; tempus; t1
Print "------------------------------------"
Return f
Case 81
If lenI < 3 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
bpm$ = Hex(legge_byte(), 2)
bpm$ &= Hex(legge_byte(), 2)
bpm$ &= Hex(legge_byte(), 2)
salto(lenI - 3)
Case Else ' Ignora gli altri Meta-eventi
salto(lenI)
End Select
Case Else ' Comando Fx non valido
Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
End Select
Case Else
Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
End Select
Wend
End
Private Function legge_var() As Integer ' Legge un numero a lunghezza-variabile (tempo Delta)
Dim valore As Integer
Dim c As Byte
Read #fl, c
valore = c And 127
If c And 128 Then
Read #fl, c
valore = (valore * CInt(2 ^ 7)) Or (c And 127)
If c And 128 Then
Read #fl, c
valore = (valore * CInt(2 ^ 7)) Or (c And 127)
If c And 128 Then
Read #fl, c
valore = (valore * CInt(2 ^ 7)) Or c
If c And 128 Then Return -1
Endif
Endif
Endif
Return valore
End
Private Function legge_byte() As Byte
Dim b As Byte
Inc file_offset
Read #fl, b
Return b
End
Private Procedure salto(b As Byte)
While b > 0
legge_byte()
Dec b
Wend
file_offset += b
End
Private Function legge_dal_file(by As Short) As Integer
Dim valore As Integer
Dim b As Byte
Do
Read #fl, b
If b = -1 Then Return -1
valore = (valore * CInt(2 ^ 8)) Or b
Dec by
Loop Until by = 0
Return valore
End
