Обработка MIDI ввода нескольких системных эксклюзивных сообщений в VB - PullRequest
0 голосов
/ 20 октября 2018

Обычно речь идет о получении нескольких эксклюзивных сообщений системы MIDI, но в частности комплект, оснащенный MIDI, представляет собой гитарный усилитель Fender Cyber ​​Twin (CT).

Примечание: SYSEX = эксклюзив системы

I знаю если я отправлю этот запрос на одиночную предустановку MIDI из моего приложения:

{ F0, 08, 21, 11, 04, 22, 00, 00, 00, 02, 7B, F7 }

на КТ или я дам его вручную с КТ, КТ хорошо отправит следующий SYSEXсообщения в соответствии с приложением MIDI_OX:

TIMESTAMP IN PORT STATUS DATA1 DATA2 CHAN NOTE EVENT               
 00003A9A   1   2     F0  Buffer:     6 Bytes   System Exclusive      
 SYSX: F0 08 21 11 02 F7
 00003B7F   1   2     F0  Buffer:    55 Bytes   System Exclusive      
 SYSX: F0 08 21 11 02 00 00 38 00 56 69 62 72 6F 2D 50 00 61
 SYSX: 67 65 20 20 20 20 07 20 20 08 5A 61 68 70 1D 4F 50 6E
 SYSX: 24 10 79 14 1C 00 77 26 0D 54 69 64 40 5D 3C 4D 7F 4F
 SYSX: F7
 00003BDC   1   2     F0  Buffer:     7 Bytes   System Exclusive      
 SYSX: F0 08 21 11 02 7B F7

т.е. 3 {F0 ... F7} SYSEX-пакетов.

Когда я отправляю MIDI-запрос одиночного предустановленного дампаиз моей кнопки я получаю только первый {F0 08 21 11 02 F7}, стартовый пакет файла дампа КТ для одной предустановки (6 байт).

Как получитьдругие 2 пакета.Второй - сам файл (55) байтов и конечный пакет файла дампа CT (7 байтов)

Для ясности речь идет о получении нескольких сообщений SYSEX, а НЕ о CT * 1024.* это просто тот комплект, который я подключил.

Есть еще один способ задать вопрос:

Как мне постоянно принимать прием SYSEX независимо от того, приходит ли онкак ответ на мое приложение (т.е. ожидается получение нескольких сообщений SYSEX) или внешне (т.е. не знаю, чего ожидать и когда)

Я, безусловно, что-то упускаю !!

Myконсоль отображает:

yaaay found MIDI Plus In @ 0
yaaay found MIDI Plus @ 1
hello
response: 0, hMIDIout: 13573704
size of requestdump: 12
Hello from MIDIin
MIM_OPEN
response midiInOpen: 0, hMIDIin: 13572912
response midiInPrepareHeader: 0, hMIDIin: 13572912
response midiInAddBuffer: 0, hMIDIin: 13572912
response : 0, hMIDIin: 13572912
sizes: 48
size of requestdump: 12
response: 0
response: 0
response: 0
sent: 
F0, 08, 21, 11, 04, 22, 00, 00, 00, 02, 7B, F7
MIM_LONGDATA: wParam = 0x02C8CF10
bytes recorded: 6
F0, 08, 21, 11, 02, F7
flags: 0x0003
next: 0x0000

Никаких ошибок MIDI, но только стартовый пакет файла дампа CT для одного пресета (6 байтов)!

Это мои MIDI IN и MIDI OUT классы и модуль Form и MIDIglobals : Форма находит только те устройства ввода / вывода MIDI, которые мне нужны, создает новые экземпляры MIDIin и MIDIout на основеих идентификаторы устройств и имеет кнопку для запуска одного рсбросить дамп с моего CT.

MIDI IN

Imports System.Runtime.InteropServices
Public Class MIDIin
Dim sysexbufffer(8192) As Byte
Dim hMIDIin As Integer
Dim MidiInHdr As New MIDIHDR
Dim n As Integer

Public Sub New(ByVal device As Integer)
    Dim response As Integer
    Console.Out.WriteLine("Hello from MIDIin")
    response = midiInOpen(hMIDIin, device, AddressOf MidiCallback, 1, MIDI_CALLBACK_FUNCTION Or MIDI_IO_STATUS)
    Console.Out.WriteLine("response midiInOpen: " & response & ", hMIDIin: " & hMIDIin)
    MidiInHdr.dwBufferLength = sysexbufffer.Length
    MidiInHdr.lpData = Marshal.AllocHGlobal(sysexbufffer.Length)
    response = midiInPrepareHeader(hMIDIin, MidiInHdr, sysexbufffer.Length)
    Console.Out.WriteLine("response midiInPrepareHeader: " & response & ", hMIDIin: " & hMIDIin)
    response = midiInAddBuffer(hMIDIin, MidiInHdr, Marshal.SizeOf(MidiInHdr))
    Console.Out.WriteLine("response midiInAddBuffer: " & response & ", hMIDIin: " & hMIDIin)
    response = midiInStart(hMIDIin)
    Console.Out.WriteLine("response : " & response & ", hMIDIin: " & hMIDIin)
End Sub

Sub MidiCallback(ByVal MidiHandle As Int32, ByVal wMsg As Int32, ByVal Instance As Int32, ByVal wParam As Int32, ByVal lParam As Int32)
    'Dim g As String = "MidiCallBack(" & Hex4(wMsg) & ", " & Instance & ", " & Hex4(wParam) & ", " & Hex4(lParam) & ")"
    'Console.Out.WriteLine("MidiCallBack vMsg: 0x" & Hex4(wMsg))
    Select Case wMsg
        Case MIM_OPEN
            Console.Out.WriteLine("MIM_OPEN")

        Case MIM_CLOSE
            Console.Out.WriteLine("MIM_CLOSE")

        Case MIM_DATA
            Console.Out.WriteLine("MIM_DATA wParam: 0x" & Hex8(wParam))

        Case MIM_LONGDATA
            Console.Out.WriteLine("MIM_LONGDATA: wParam = 0x" & Hex8(wParam))
            Console.Out.WriteLine("bytes recorded: " & MidiInHdr.dwBytesRecorded)
            Dim i As Integer
            Dim b As Byte
            For i = 0 To MidiInHdr.dwBytesRecorded - 1
                b = Marshal.ReadByte(MidiInHdr.lpData + i)
                Console.Out.Write(Hex2(b) & IIf(i < MidiInHdr.dwBytesRecorded - 1, ", ", vbCrLf))
            Next
            Console.Out.WriteLine("flags: 0x" & Hex4(MidiInHdr.dwFlags))
            Console.Out.WriteLine("next: 0x" & Hex4(MidiInHdr.lpNext))

        Case Else
            Console.Out.WriteLine("Not known:  vMsg: 0x" & Hex8(wMsg))

    End Select
    n = n + 1
End Sub
Protected Overrides Sub Finalize()
    midiInStop(hMIDIin)
    midiInClose(hMIDIin)
    Marshal.FreeHGlobal(MidiInHdr.lpData)
    Console.Out.WriteLine("finalised MIDI In: " & hMIDIin)
End Sub
End Class

MIDI OUT

Imports System.Runtime.InteropServices
Class MIDIout
Dim requestdump As Byte() =
{cSEX, cFender, cAMP, cCYBERTWIN, cMESSAGEID, cDUMPREQUEST, cUNUSED, cUNUSED, cUNUSED, cDUMPID, cEOXFILE, cEOX}

Dim hMIDIout As Integer
Dim MidiOutHdr As New MIDIHDR

Public Sub New(ByVal device As Integer)
    Dim response As Integer
    Console.Out.WriteLine("hello")
    response = midiOutOpen(hMIDIout, device, 0, 0, 0)
    Console.Out.WriteLine("response: " & response & ", hMIDIout: " & hMIDIout)
    Console.Out.WriteLine("size of requestdump: " & requestdump.Length)
End Sub

Private Sub dumpRequest(ByVal type As Integer)
    requestdump(cDUMPIDBYTE) = type
    If type < 1 Or type > 3 Then
        Console.Out.WriteLine("bad request type: " & type)
        Exit Sub
    End If
    Dim response As Integer
    Console.Out.WriteLine("sizes: " & Marshal.SizeOf(MidiOutHdr))
    Console.Out.WriteLine("size of requestdump: " & requestdump.Length)
    MidiOutHdr.dwBufferLength = requestdump.Length
    MidiOutHdr.lpData = Marshal.AllocHGlobal(requestdump.Length)
    Marshal.Copy(requestdump, 0, MidiOutHdr.lpData, requestdump.Length)
    response = midiOutPrepareHeader(hMIDIout, MidiOutHdr, Marshal.SizeOf(MidiOutHdr))
    Console.Out.WriteLine("response: " & response)
    response = midiOutLongMsg(hMIDIout, MidiOutHdr, Marshal.SizeOf(MidiOutHdr))
    Console.Out.WriteLine("response: " & response)
    response = midiOutUnprepareHeader(hMIDIout, MidiOutHdr, Marshal.SizeOf(MidiOutHdr))
    Console.Out.WriteLine("response: " & response)

    Marshal.FreeHGlobal(MidiOutHdr.lpData)
    Dim i As Integer
    Console.Out.WriteLine("sent: ")
    For i = 0 To 11
        Console.Out.Write(Hex2(requestdump(i)) & IIf(i = 11, vbCrLf, ", "))
    Next
End Sub


Public Sub RequestUtilitiesDump()
    dumpRequest(cUTILITIESDUMPID)
End Sub


Public Sub RequestSinglePresetDump()
    dumpRequest(cSINGLEPRESETDUMPID)
End Sub


Public Sub RequestAllPresetsDump()
    dumpRequest(cALLPRESETSDUMPID)
End Sub

Protected Overrides Sub Finalize()
    midiOutClose(hMIDIout)
    Console.Out.WriteLine("finalised MIDI out: " & hMIDIout)
End Sub
End Class

Форма

Imports System.Runtime.InteropServices
Class Form1
Dim outdevice As Integer = -1
Dim indevice As Integer = -1
Dim mOut As MIDIout
Dim mIn As MIDIin

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Dim incaps As New MIDIINCAPS
    Dim outcaps As New MIDIOUTCAPS
    Dim NumberOfInDevices As Integer
    Dim NumberOfOutDevices As Integer
    Dim devicesought As String = "midi plus"
    NumberOfInDevices = midiInGetNumDevs()
    NumberOfOutDevices = midiOutGetNumDevs()
    Dim device As Integer
    For device = 0 To NumberOfInDevices - 1
        midiInGetDevCaps(device, incaps, Marshal.SizeOf(incaps))
        If incaps.szPname.ToLower.Equals(devicesought) Then
            Console.Out.WriteLine("Found MIDI Plus In @ " & device)
            indevice = device
        End If
    Next
    For device = 0 To NumberOfOutDevices - 1
        midiOutGetDevCaps(device, outcaps, Marshal.SizeOf(outcaps))
        If outcaps.szPname.ToLower.Equals(devicesought) Then
            Console.Out.WriteLine("yaaay found MIDI Plus @ " & device)
            outdevice = device
        End If
    Next
    mOut = New MIDIout(outdevice)
    mIn = New MIDIin(indevice)
End Sub

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    mOut.RequestSinglePresetDump()
End Sub
End Class

MIDIglobals

Imports System.Runtime.InteropServices

Module MIDIglobals
Public Function Hex2(b As Byte) As String
    Hex2 = Strings.Right("00" & Hex(b), 2)
End Function
Public Function HexInt2(i As Integer) As String
    Dim b As Byte = (i And &HFF)
    HexInt2 = Hex2(b)
End Function
Public Function Hex4(i As Integer) As String
    Hex4 = Strings.Right("0000" & Hex(i), 4)
End Function
Public Function Hex8(i As Integer) As String
    Hex8 = Strings.Right("00000000" & Hex(i), 8)
End Function

'for Cyber Twin
Public Const cSEX As Byte = &HF0
Public Const cEOX As Byte = &HF7
Public Const cFender As Byte = &H8
Public Const cAMP As Byte = &H21
Public Const cCYBERTWIN As Byte = &H11
Public Const cMESSAGEID As Byte = &H4
Public Const cDUMPREQUEST As Byte = &H22
Public Const cUNUSED As Byte = &H0
Public Const cDUMPID As Byte = &H0
Public Const cUTILITIESDUMPID As Byte = &H1
Public Const cSINGLEPRESETDUMPID As Byte = &H2
Public Const cALLPRESETSDUMPID As Byte = &H3
Public Const cEOXFILE As Byte = &H7B
Public Const cDUMPIDBYTE As Byte = 9

' MIDI input device capabilities structure
Public Structure MIDIINCAPS
    Dim wMid As Short ' Manufacturer ID
    Dim wPid As Short ' Product ID
    Dim vDriverVersion As Integer ' Driver version
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim szPname As String ' Product Name
    Dim dwSupport As Integer ' Supported extras
End Structure

' MIDI output device capabilities structure
Public Structure MIDIOUTCAPS
    Dim wMid As Short ' Manufacturer ID
    Dim wPid As Short ' Product ID
    Dim vDriverVersion As Integer ' Driver version
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> Dim szPname As String ' Product Name
    Dim wTechnology As Short ' Device type
    Dim wVoices As Short ' n. of voices (internal synth only)
    Dim wNotes As Short ' max n. of notes (internal synth only)
    Dim wChannelMask As Short ' n. of Midi channels (internal synth only)
    Dim dwSupport As Integer ' Supported extra controllers (volume, etc)
End Structure

' MIDI data block header
Public Structure MIDIHDR
    Dim lpData As IntPtr ' pointer to locked data block
    Dim dwBufferLength As Integer ' length of data in data block
    Dim dwBytesRecorded As Integer ' used for input only
    Dim dwUser As Integer ' for client's use
    Dim dwFlags As Integer ' assorted flags (see defines)
    Dim lpNext As Integer ' reserved for driver
    Dim reserved As Integer ' reserved for driver
    Dim dwOffset As Integer
    Dim reserved1 As Integer
    Dim reserved2 As Integer
    Dim reserved3 As Integer
    Dim reserved4 As Integer
End Structure

'Input functions
Declare Function midiInGetNumDevs Lib "winmm.dll" () As Short
Declare Function midiInGetDevCaps Lib "winmm.dll" Alias "midiInGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIINCAPS, ByVal uSize As Integer) As Integer
Declare Function midiInGetErrorText Lib "winmm.dll" Alias "midiInGetErrorTextA" (ByVal err_Renamed As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
Declare Function midiInOpen Lib "winmm.dll" (ByRef lphMidiIn As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As MidiDelegate,
        ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIN As Integer) As Integer
Declare Function midiInPrepareHeader Lib "winmm.dll" (ByVal hMidiIN As Integer, ByRef lpMidiInHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Declare Function midiInUnprepareHeader Lib "winmm.dll" (ByVal hMidiIN As Integer, ByRef lpMidiInHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Declare Function midiInAddBuffer Lib "winmm.dll" (ByVal hMidiIN As Integer, ByRef lpMidiInHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIN As Integer) As Integer
Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIN As Integer) As Integer
Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIN As Integer) As Integer

'Output functions
Declare Function midiOutGetNumDevs Lib "winmm.dll" () As Short
Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Integer, ByRef lpCaps As MIDIOUTCAPS, ByVal uSize As Integer) As Integer
Declare Function midiOutGetErrorText Lib "winmm.dll" Alias "midiOutGetErrorTextA" (ByVal errcode As Integer, ByVal lpText As String, ByVal uSize As Integer) As Integer
Declare Function midiOutOpen Lib "winmm.dll" (ByRef lphMidiOut As Integer, ByVal uDeviceID As Integer, ByVal dwCallback As Integer,
        ByVal dwInstance As Integer, ByVal dwFlags As Integer) As Integer
Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Integer) As Integer
Declare Function midiOutPrepareHeader Lib "winmm.dll" (ByVal hMidiOut As Integer, ByRef lpMidiOutHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Declare Function midiOutUnprepareHeader Lib "winmm.dll" (ByVal hMidiOut As Integer, ByRef lpMidiOutHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Integer, ByVal dwMsg As Integer) As Integer
Declare Function midiOutLongMsg Lib "winmm.dll" (ByVal hMidiOut As Integer, ByRef lpMidiOutHdr As MIDIHDR, ByVal uSize As Integer) As Integer
Public Delegate Sub MidiDelegate(ByVal MidiHandle As Int32, ByVal wMsg As Int32, ByVal Instance As Int32, ByVal wParam As Int32, ByVal lParam As Int32)

' Callback Function constants
Public Const MIDI_CALLBACK_FUNCTION As Integer = &H30000 ' dwCallback is a FARPROC
Public Const MIDI_IO_STATUS As Integer = &H20 ' include longdata and moredata
Public Const MIM_OPEN As Short = &H3C1S ' MIDI In Port Opened
Public Const MIM_CLOSE As Short = &H3C2S ' MIDI In Port Closed
Public Const MIM_DATA As Short = &H3C3S ' MIDI In Short Data (e.g. Notes & CC)
Public Const MIM_LONGDATA As Short = &H3C4S ' MIDI In Long Data (i.e. SYSEX)
Public Const MIM_MOREDATA As Short = &H3CCS ' MIDI In More Data overflow of non sys ex data
Public Const MIM_ERROR As Short = &H3C5S ' MIDI In Error
Public Const MIM_LONGERROR As Short = &H3C6S ' MIDI In Long Error
Public Const MOM_OPEN As Short = &H3C7S ' MIDI Out Port Opened
Public Const MOM_CLOSE As Short = &H3C8S ' MIDI Out Port Closed
Public Const MOM_DONE As Short = &H3C9S ' MIDI Out Data sending completed
Public Const MOM_POSITIONCB As Short = &HCAS ' MIDI Out Position requested

' Midi Error Constants
Public Const MMSYSERR_NOERROR As Short = 0
Public Const MMSYSERR_ERROR As Short = 1
Public Const MMSYSERR_BADDEVICEID As Short = 2
Public Const MMSYSERR_NOTENABLED As Short = 3
Public Const MMSYSERR_ALLOCATED As Short = 4
Public Const MMSYSERR_INVALHANDLE As Short = 5
Public Const MMSYSERR_NODRIVER As Short = 6
Public Const MMSYSERR_NOMEM As Short = 7
Public Const MMSYSERR_NOTSUPPORTED As Short = 8
Public Const MMSYSERR_BADERRNUM As Short = 9
Public Const MMSYSERR_INVALFLAG As Short = 10
Public Const MMSYSERR_INVALPARAM As Short = 11
Public Const MMSYSERR_HANDLEBUSY As Short = 12
Public Const MMSYSERR_INVALIDALIAS As Short = 13
Public Const MMSYSERR_BADDB As Short = 14
Public Const MMSYSERR_KEYNOTFOUND As Short = 15
Public Const MMSYSERR_READERROR As Short = 16
Public Const MMSYSERR_WRITEERROR As Short = 17
Public Const MMSYSERR_DELETEERROR As Short = 18
Public Const MMSYSERR_VALNOTFOUND As Short = 19
Public Const MMSYSERR_NODRIVERCB As Short = 20
Public Const MMSYSERR_LASTERROR As Short = 20
Public Const MIDIERR_UNPREPARED As Short = 64 ' header not prepared
Public Const MIDIERR_STILLPLAYING As Short = 65 ' still something playing
Public Const MIDIERR_NOMAP As Short = 66 ' no current map
Public Const MIDIERR_NOTREADY As Short = 67 ' hardware is still busy
Public Const MIDIERR_NODEVICE As Short = 68 ' port no longer connected
Public Const MIDIERR_INVALIDSETUP As Short = 69 ' invalid setup
Public Const MIDIERR_LASTERROR As Short = 69 ' last error in range

' Midi Header flags
Public Const MHDR_DONE As Short = 1 ' Set by the device driver to indicate that it is finished with the buffer and is returning it to the application.
Public Const MHDR_PREPARED As Short = 2 ' Set by Windows to indicate that the buffer has been prepared
Public Const MHDR_INQUEUE As Short = 4 ' Set by Windows to indicate that the buffer is queued for playback
Public Const MHDR_ISSTRM As Short = 8 ' Set to indicate that the buffer is a stream buffer
End Module

Ответы [ 2 ]

0 голосов
/ 21 октября 2018

@ CL.Спасибо.На самом деле, я делал шаги в этом направлении.Мой класс MIDIin теперь выглядит следующим образом:

Imports System.Runtime.InteropServices
Public Class MIDIin
Const SYSEXbufferSize = 64
Const NumSysExHeaders = 10
Dim hMIDIin As Integer
Dim MidiInHdr(NumSysExHeaders) As MIDIHDR
Dim n As Integer
Dim mhdr As New MIDIHDR


Public Sub New(ByVal device As Integer
    Dim response As Integer, i As Integer
    Console.Out.WriteLine("Hello from MIDIin")
    response = midiInOpen(hMIDIin, device, AddressOf MidiCallback, 1, MIDI_CALLBACK_FUNCTION Or MIDI_IO_STATUS)
    Console.Out.WriteLine("response midiInOpen: " & response & ", hMIDIin: " & hMIDIin)
    Dim size As Integer = Marshal.SizeOf(mhdr)
    For i = 0 To NumSysExHeaders - 1
        MidiInHdr(i) = New MIDIHDR
        MidiInHdr(i).dwBufferLength = SYSEXbufferSize
        ' save the array index in the dwUser member for later use
        MidiInHdr(i).dwUser = i
        MidiInHdr(i).lpData = Marshal.AllocHGlobal(SYSEXbufferSize)
        response = midiInPrepareHeader(hMIDIin, MidiInHdr(i), size)
        Console.Out.WriteLine("??: " & MidiInHdr(i).lpData.ToString)
        response = midiInAddBuffer(hMIDIin, MidiInHdr(i), size)
        'Console.Out.WriteLine("response midiInAddBuffer: " & response & ", hMIDIin: " & hMIDIin)
    Next
    response = midiInStart(hMIDIin)
    Console.Out.WriteLine("response : " & response & ", hMIDIin: " & hMIDIin)
End Sub

Sub MidiCallback(ByVal MidiHandle As Int32, ByVal wMsg As Int32, ByVal Instance As Int32, ByVal wParam As Int32, ByVal lParam As Int32)
    'Dim g As String = "MidiCallBack(" & Hex4(wMsg) & ", " & Instance & ", " & Hex4(wParam) & ", " & Hex4(lParam) & ")"
    'Console.Out.WriteLine("MidiCallBack vMsg: 0x" & Hex4(wMsg))
    Select Case wMsg
        Case MIM_OPEN
            Console.Out.WriteLine("MIM_OPEN")

        Case MIM_CLOSE
            Console.Out.WriteLine("MIM_CLOSE")

        Case MIM_DATA
            Console.Out.WriteLine("MIM_DATA wParam: 0x" & Hex8(wParam))

        Case MIM_LONGDATA
            Console.Out.WriteLine("MIM_LONGDATA: wParam = 0x" & Hex8(wParam))
            ' I haven't the frst clue of how to change wParam into a pointerto a MIDIHDR structure
            'so get Get the index of my arrays of MIDIHDRs from the dwUser member
            'by using Marshal
            Dim mhdrIndex = Marshal.ReadInt32(wParam + 12)
            Console.Out.WriteLine("mhdrIndex: " & mhdrIndex)
            Dim count As Integer = 0
            Dim b As Byte
            For i = 0 To MidiInHdr(mhdrIndex).dwBytesRecorded - 1
                b = Marshal.ReadByte(MidiInHdr(mhdrIndex).lpData + i)
                Console.Out.Write(Hex2(b))
                count = count + 1
                If count > 7 Or i = MidiInHdr(mhdrIndex).dwBytesRecorded - 1 Then
                    Console.Out.Write(vbCrLf)
                    count = 0
                Else
                    Console.Out.Write(", ")
                End If
            Next
            If MidiInHdr(mhdrIndex).dwFlags And MHDR_DONE <> 0 Then
                ' tidy up just incase. it makes no difference anyway
                midiInUnprepareHeader(hMIDIin, MidiInHdr(mhdrIndex), Marshal.SizeOf(MidiInHdr(mhdrIndex)))
                MidiInHdr(mhdrIndex).dwUser = mhdrIndex
                midiInPrepareHeader(hMIDIin, MidiInHdr(mhdrIndex), Marshal.SizeOf(MidiInHdr(mhdrIndex)))
                ' add the buffer back
                midiInAddBuffer(hMIDIin, MidiInHdr(mhdrIndex), Marshal.SizeOf(MidiInHdr(mhdrIndex)))
            End If

        Case Else
            'display the rest of messages generically
            Console.Out.WriteLine("Not known:  vMsg: 0x" & Hex8(wMsg))

            'Case MM_MOREDATA

    End Select
    n = n + 1
End Sub
Protected Overrides Sub Finalize()
    Dim i As Integer
    midiInStop(hMIDIin)
    midiInClose(hMIDIin)
    For i = 0 To MidiInHdr.Length - 1
        Marshal.FreeHGlobal(MidiInHdr(i).lpData)
    Next
    Console.Out.WriteLine("finalised MIDI In: " & hMIDIin)
End Sub


End Class

При отправке дампа все предварительные запросы через:

F0, 08, 21, 11, 04, 22, 00, 00, 00, 03, 7B, F7

Теперь я вижу все патчи:

hello
response: 0, hMIDIout: 14321304
size of requestdump: 12
Hello from MIDIin
MIM_OPEN
response midiInOpen: 0, hMIDIin: 14318840
??: 14650696
??: 14650264
??: 14651488
??: 14651560
??: 14651632
??: 14650336
??: 14649112
??: 14648032
??: 14647816
??: 14648536
response : 0, hMIDIin: 14318840
sizes: 48
size of requestdump: 12
response: 0
response: 0
response: 0
sent: 
F0, 08, 21, 11, 04, 22, 00, 00, 00, 03, 7B, F7
MIM_LONGDATA: wParam = 0x02B3D014
mhdrIndex: 0
F0, 08, 21, 11, 03, F7 ' start of file marker
MIM_LONGDATA: wParam = 0x02B3D044
mhdrIndex: 1
F0, 08, 21, 11, 03, 00, 00, 55
00, 43, 68, 61, 6D, 70, 20, 27
00, 34, 39, 20, 20, 20, 20, 20
05, 20, 20, 24, 0C, 40, 44, 51
0B, 40, 7F, 7C, 48, 28, 73, 68
00, 00, 00, 7F, 7F, 7F, 7F, 00
00, 00, 00, 00, 00, 58, F7
MIM_LONGDATA: wParam = 0x02B3D074
mhdrIndex: 2
F0, 08, 21, 11, 03, 01, 00, 56
00, 43, 68, 61, 6D, 70, 20, 27
00, 34, 39, 20, 20, 20, 20, 20
05, 20, 20, 24, 0C, 40, 42, 51
0B, 40, 7F, 7C, 48, 28, 73, 68
00, 00, 00, 7F, 7F, 7F, 7F, 00
00, 00, 00, 00, 00, 5C, F7
MIM_LONGDATA: wParam = 0x02B3D0A4
mhdrIndex: 3
F0, 08, 21, 11, 03, 02, 00, 57
00, 41, 20, 54, 77, 69, 6E, 20
00, 52, 65, 76, 65, 72, 62, 20
0D, 20, 20, 1C, 09, 42, 08, 52
1D, 4C, 72, 02, 16, 3C, 52, 1A
73, 7F, 04, 45, 59, 7F, 59, 60
48, 05, 31, 3D, 05, 4A, F7
MIM_LONGDATA: wParam = 0x02B3D0D4
mhdrIndex: 4
F0, 08, 21, 11, 03, 03, 00, 58
00, 43, 6F, 75, 6E, 74, 72, 79
00, 20, 54, 77, 61, 6E, 67, 65
0D, 72, 20, 04, 01, 40, 18, 50
15, 44, 2E, 3C, 75, 79, 5C, 74
1F, 32, 7A, 56, 48, 18, 5D, 1E
18, 41, 7F, 57, 7F, 0F, F7
MIM_LONGDATA: wParam = 0x02B3D104
mhdrIndex: 5
F0, 08, 21, 11, 03, 04, 00, 59
00, 4A, 61, 7A, 7A, 20, 49, 49
00, 20, 20, 20, 20, 20, 20, 20
0D, 20, 20, 1C, 31, 40, 08, 55
3A, 40, 0D, 15, 14, 6E, 44, 5D
1C, 04, 0F, 63, 71, 3E, 52, 4A
18, 4B, 7D, 46, 7C, 46, F7

вплоть до:

mhdrIndex: 4
F0, 08, 21, 11, 03, 4B, 01, 4B
00, 56, 69, 6E, 74, 61, 67, 65
00, 20, 53, 74, 61, 63, 6B, 20
0D, 20, 20, 10, 66, 40, 58, 51
3B, 40, 7E, 4F, 48, 20, 65, 6D
00, 1B, 00, 7F, 7F, 7F, 7F, 00
00, 00, 00, 00, 00, 31, F7
MIM_LONGDATA: wParam = 0x02B3D104
mhdrIndex: 5
F0, 08, 21, 11, 03, 4C, 01, 4C
00, 4D, 6F, 64, 65, 72, 6E, 20
00, 53, 74, 61, 63, 6B, 20, 20
0D, 20, 20, 45, 6E, 40, 58, 50
3F, 40, 0F, 06, 7A, 03, 36, 1C
40, 22, 7C, 7F, 7F, 7F, 7F, 00
00, 00, 00, 00, 00, 3E, F7
MIM_LONGDATA: wParam = 0x02B3D134
mhdrIndex: 6
F0, 08, 21, 11, 03, 7B, F7  end of file marker

но BANG !!!в конце концов это происходит ...

    CallbackOnCollectedDelegate occurred Message: 
    Managed Debugging Assistant 'CallbackOnCollectedDelegate' 
    has detected a problem in 
   'C:\Visual Studio Projects\VisualBasic\MIDISysEx\MIDISysEx\
    bin\Debug\MIDISysEx.vshost.exe'. 
    Additional information: A callback was made on a garbage 
    collected delegate of type 
    'MIDISysEx!MIDISysEx.MIDIglobals+MidiDelegate::Invoke'. 
    This may cause application crashes, corruption and data loss. 
    When passing delegates to unmanaged code, they must be kept 
    alive by the managed application until it is guaranteed that 
    they will never be called.

Это происходит независимо от того, получаю ли я данные дампа в ответ на свое приложение или вручную от усилителя MIDI.

Скажите, пожалуйста, почему?

0 голосов
/ 21 октября 2018

После того, как ваш обратный вызов обработал данные в буфере, он должен быть повторно отправлен с помощью midiInAddBuffer.

И для обработки нескольких сообщений, поступающих одновременно, у вас должно быть несколько буферов.

И прежде чем закрыть устройство, вы должны сбросить настройки устройства, чтобы вернуть все ожидающие буферы , и очистить буферы .

...