I tried this in QB64PE, and got a bunch of errors which I cleaned up as best I could, but getting an invalid array name error on line 87:
fileHandle& = _OPEN(midiFilePath$, _OPENEXISTING, _OPENBINARY)
I'm guessing this is opening a binary file(? ) which I haven't done in QB64 or PE (or if I did it's been a long time) and I think the problem is gemini was fudging these commands.
It also threw an error on the declare library but I think it needs "winmm.h", which I found online and attached (but not sure if it's the right verson?)
Anyway, here is the latest code...
Oh and if you need a MIDI file to test it with, go to https://freemidi.org/
fileHandle& = _OPEN(midiFilePath$, _OPENEXISTING, _OPENBINARY)
I'm guessing this is opening a binary file(? ) which I haven't done in QB64 or PE (or if I did it's been a long time) and I think the problem is gemini was fudging these commands.
It also threw an error on the declare library but I think it needs "winmm.h", which I found online and attached (but not sure if it's the right verson?)
Anyway, here is the latest code...
Oh and if you need a MIDI file to test it with, go to https://freemidi.org/
Code: (Select All)
' Be sure to include "winmm.h" in the same folder as the program
' winmm.h can be found at https://github.com/github/VisualStudio/blob/master/tools/Debugging%20Tools%20for%20Windows/winext/manifest/winmm.h
' Requires file access permissions
'DECLARE LIBRARY "winmm.dll"
Declare Library "winmm"
' No winmm functions used, but keeping it in case you want to add MIDI playback
End Declare
Type MIDIHDR
MThd As String
Length As Long
Format As Integer
Tracks As Integer
Division As Integer
End Type
Type MIDITRACK
MTrk As String
Length As String
Events As String
End Type
Type MIDIEVENT
DeltaTime As Long
Status As Integer
Data1 As Integer
Data2 As Integer
End Type
Function ReadVariableLength& (data1 As String, offset1 As Long)
Dim value1&
Dim byte1%
value& = 0
Do
byte1% = Asc(Mid$(data1, offset1, 1))
value1& = (value1& * 128) + (byte1% And 127)
offset1& = offset1& + 1
Loop While (byte1% And 128) <> 0
ReadVariableLength& = value1&
End Function ' ReadVariableLength&
Function WriteVariableLength$ (value&)
Dim result$: result$ = ""
Dim bytes$(1 To 4)
Dim numBytes%
Dim i%
If value& = 0 Then
WriteVariableLength$ = Chr$(0)
Exit Function
End If
numBytes% = 0
Do
numBytes% = numBytes% + 1
bytes$(numBytes%) = Chr$(value& And 127)
value& = value& \ 128
Loop While value& > 0
For i% = numBytes% - 1 To 1 Step -1
bytes$(i%) = Chr$(Asc(bytes$(i%)) Or 128)
Next i%
For i% = 1 To numBytes%
result$ = result$ + bytes$(i%)
Next i%
WriteVariableLength$ = result$
End Function ' WriteVariableLength$
Sub MidiToText (midiFilePath$, textFilePath$)
Dim fileHandle&
Dim fileSize&
Dim midiData$
Dim header As MIDIHDR
Dim tracks(1 To 256) As MIDITRACK
Dim trackCount%
Dim offset&
Dim eventOffset&
Dim event As MIDIEVENT
Dim textFileHandle&
Dim eventData$
fileHandle& = _OPEN(midiFilePath$, _OPENEXISTING, _OPENBINARY)
IF fileHandle& = 0 THEN
PRINT "Error opening MIDI file."
EXIT SUB
END IF
fileSize& = LOF(fileHandle&)
midiData$ = SPACE$(fileSize&)
_GET fileHandle&, midiData$
_CLOSE fileHandle&
header.MThd$ = MID$(midiData$, 1, 4)
header.Length& = (ASC(MID$(midiData$, 5, 1)) * 256 * 256 * 256) + (ASC(MID$(midiData$, 6, 1)) * 256 * 256) + (ASC(MID$(midiData$, 7, 1)) * 256) + ASC(MID$(midiData$, 8, 1))
header.Format% = (ASC(MID$(midiData$, 9, 1)) * 256) + ASC(MID$(midiData$, 10, 1))
header.Tracks% = (ASC(MID$(midiData$, 11, 1)) * 256) + ASC(MID$(midiData$, 12, 1))
header.Division% = (ASC(MID$(midiData$, 13, 1)) * 256) + ASC(MID$(midiData$, 14, 1))
offset& = 15
FOR trackCount% = 1 TO header.Tracks%
tracks(trackCount%).MTrk$ = MID$(midiData$, offset&, 4)
tracks(trackCount%).Length& = (ASC(MID$(midiData$, offset& + 4, 1)) * 256 * 256 * 256) + (ASC(MID$(midiData$, offset& + 5, 1)) * 256 * 256) + (ASC(MID$(midiData$, offset& + 6, 1)) * 256) + ASC(MID$(midiData$, offset& + 7, 1))
tracks(trackCount%).Events$ = MID$(midiData$, offset& + 8, tracks(trackCount%).Length&)
offset& = offset& + 8 + tracks(trackCount%).Length&
NEXT trackCount%
textFileHandle& = _OPEN(textFilePath$, _OPENCREATE, _OPENOUTPUT)
IF textFileHandle& = 0 THEN
PRINT "Error creating text file."
EXIT SUB
END IF
PRINT #textFileHandle&, "Track" + CHR$(9) + "DeltaTime" + CHR$(9) + "Status" + CHR$(9) + "Data1" + CHR$(9) + "Data2"
FOR trackCount% = 1 TO header.Tracks%
eventOffset& = 1
DO WHILE eventOffset& <= LEN(tracks(trackCount%).Events$)
event.DeltaTime& = ReadVariableLength&(tracks(trackCount%).Events$, eventOffset&)
eventOffset& = eventOffset& + LEN(WriteVariableLength$(event.DeltaTime&))
event.Status% = ASC(MID$(tracks(trackCount%).Events$, eventOffset&, 1))
eventOffset& = eventOffset& + 1
IF event.Status% < &HF0 THEN
event.Data1% = ASC(MID$(tracks(trackCount%).Events$, eventOffset&, 1))
event.Data2% = ASC(MID$(tracks(trackCount%).Events$, eventOffset& + 1, 1))
eventOffset& = eventOffset& + 2
ELSEIF event.Status% = &HFF THEN
'Meta event: handle as needed. This simple version skips metadata.
DIM metaType%, metaLength&
metaType% = ASC(MID$(tracks(trackCount%).Events$, eventOffset&, 1))
eventOffset& = eventOffset& +1
metaLength& = ReadVariableLength&(tracks(trackCount%).Events$, eventOffset&)
eventOffset& = eventOffset& + LEN(WriteVariableLength$(metaLength&)) + metaLength&
ELSE
event.Data1% = 0: event.Data2% = 0
eventOffset& = eventOffset& + 1
END IF
PRINT #textFileHandle&, trackCount%; CHR$(9); event.DeltaTime&; CHR$(9); event.Status%; CHR$(9); event.Data1%; CHR$(9); event.Data2%
LOOP
NEXT trackCount%
_CLOSE textFileHandle&
END SUB ' MidiToText
SUB TextToMidi (textFilePath$, midiFilePath$)
DIM fileHandle&
dim textFileHandle&
dim line$
dim parts$()
dim header AS MIDIHDR
dim tracks(1 TO 256) AS MIDITRACK
dim trackCount%
dim offset&
dim deltaTime&
dim status%
dim data1%
dim data2%
dim midiData$
dim trackData$
DIM trackLength&
textFileHandle& = _OPEN(textFilePath$, _OPENEXISTING, _OPENINPUT)
IF textFileHandle& = 0 THEN
PRINT "Error opening text file."
EXIT SUB
END IF
header.MThd$ = "MThd"
header.Length& = 6
header.Format% = 0
header.Tracks% = 1
header.Division% = 480
midiData$ = header.MThd$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(header.Length&) + CHR$(0) + CHR$(header.Format%) + CHR$(0) + CHR$(header.Tracks%) + CHR$(0) + CHR$(header.Division%)
tracks(1).MTrk$ = "MTrk"
trackData$ = ""
LINE INPUT #textFileHandle&, line$ ' Skip header line
DO WHILE NOT EOF(textFileHandle&)
LINE INPUT #textFileHandle&, line$
parts$() = SPLIT$(line$, CHR$(9))
deltaTime& = VAL(parts$(1))
status% = VAL(parts$(2))
data1% = VAL(parts$(3))
data2% = VAL(parts$(4))
trackData$ = trackData$ + WriteVariableLength$(deltaTime&) + CHR$(status%)
IF status% < &HF0 THEN
trackData$ = trackData$ + CHR$(data1%) + CHR$(data2%)
END IF
LOOP
trackData$ = trackData$ + CHR$(0) + CHR$(&HFF) + CHR$(&H2F) + CHR$(0) ' End of track meta event
trackLength& = LEN(trackData$)
midiData$ = midiData$ + tracks(1).MTrk$ + CHR$((trackLength& \ &H1000000) AND &HFF) + CHR$((trackLength& \ &H10000) AND &HFF) + CHR$((trackLength& \ &H100) AND &HFF) + CHR$(trackLength& AND &HFF) + trackData$
fileHandle& = _OPEN(midiFilePath$, _OPENCREATE, _OPENBINARY)
IF fileHandle& = 0 THEN
PRINT "Error creating MIDI file."
EXIT SUB
END IF
_PUT fileHandle&, midiData$
_CLOSE fileHandle&
_CLOSE textFileHandle&
END SUB ' TextToMidi
' Example Usage
DIM midiIn$, textOut$, midiOut$
midiIn$ = "C:\test.mid" ' Replace with your input MIDI file
textOut$ = "C:\test.txt" ' Replace with your output text file
midiOut$ = "C:\test_converted.mid" ' Replace with your output MIDI file
MidiToText midiIn$, textOut$
TextToMidi textOut$, midiOut$
PRINT "MIDI conversion complete."
END