-
Mar 1st, 2021, 08:19 AM
#1
Thread Starter
New Member
[RESOLVED] VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
Hello. I have been a long time without programming for Midi instruments. And now I can't find what is wrong in my code.
The API MidiOutGetDevCaps returns no error but do not fill the structure which remains empty.
My computer is Asus N76V, Windows 10, 64 bits.
I have tryed many variations of my code like :
- "Declare Function ..." or "Declare Auto Function ...."
- or like "Len(infoMidi_Out)" or "Marshall.sizeOf..."
- or like " Dim infoMIDI_Out As MIDIOUTCAPS" or "Dim infoMIDI_Out As New MIDIOUTCAPS"
- or "infoMIDI_Out = Nothing", this line used or deleted.
but the result is always the same.
I think I do something wrong but I am unable to know what. Can somebody help me please ?
HTML Code:
Option Explicit On
Option Strict Off
Imports System.Drawing.Bitmap
Imports System
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Collections.Specialized
Public Class form1
Public Structure MIDIOUTCAPS ' 'Structure of 52 bytes
Dim ManufacturerID As Short
Dim ProductID As Short
Public DriverVersion As Integer
<VBFixedString(32)> Public Label As String ' Product Name.
Dim Technology As Short
Dim Voices As Short
Dim Notes As Short
Dim ChannelMask As Short
Dim Support As Integer
End Structure
' API counting the number of MidiOut ports
Public Declare Function midiOutGetNumDevs Lib "winmm.dll" () As Integer
' this returns that I have 2 Midi Out ports (ports 0 and 1)
'API giving Midi Out device informations
Public Declare Auto Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (
ByVal uDeviceID As Long,
ByVal lpCaps As MIDIOUTCAPS,
ByVal uSize As Long) _ ' 32 bytes
As Long
Private Sub form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim idxOut As Integer
Dim infoMIDI_Out As MIDIOUTCAPS
Dim retour As Long
infoMIDI_Out = Nothing
For idxOut = 0 To (midiOutGetNumDevs - 1) Step 1
' display the number of Midi Out ports found
Label1.Text = (idxOut + 1) & " drivers Midi Out"
Next
idxOut = 0 ' I try to read details of port 0 only
retour = midiOutGetDevCaps(idxOut, infoMIDI_Out, Len(infoMIDI_Out))
Label2.text = "midiOutGetDevCaps retuns error n° " & retour.ToString
Label3.Text = "Len(infoMIDI_Out) = " & Len(infoMIDI_Out) ' display the lenght of the structure. Result is 52
' Display the details
Label4.Text = infoMIDI_Out.ManufacturerID.ToString
Label5.Text = infoMIDI_Out.ProductID.ToString
Label6.Text = infoMIDI_Out.DriverVersion.ToString
Label7.Text = infoMIDI_Out.Label
Label8.Text = infoMIDI_Out.Technology.ToString
End Sub
End Class
THANK YOU VERY MUCH FOR YOUR HELP.
Last edited by dday9; Mar 1st, 2021 at 09:28 AM.
Reason: Added Code Tags
-
Mar 1st, 2021, 09:37 AM
#2
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
Take a look at this PInvoke documentation: http://www.pinvoke.net/default.aspx/...etDevCaps.html and https://www.pinvoke.net/default.aspx.../MMRESULT.html
Because there isn't a Visual Basic .NET implementation, I used a code converter (this one) to convert it from C# to VB.NET. This is what I got:
Code:
Public Enum MMRESULT
MMSYSERR_NOERROR = 0
MMSYSERR_ERROR = 1
MMSYSERR_BADDEVICEID = 2
MMSYSERR_NOTENABLED = 3
MMSYSERR_ALLOCATED = 4
MMSYSERR_INVALHANDLE = 5
MMSYSERR_NODRIVER = 6
MMSYSERR_NOMEM = 7
MMSYSERR_NOTSUPPORTED = 8
MMSYSERR_BADERRNUM = 9
MMSYSERR_INVALFLAG = 10
MMSYSERR_INVALPARAM = 11
MMSYSERR_HANDLEBUSY = 12
MMSYSERR_INVALIDALIAS = 13
MMSYSERR_BADDB = 14
MMSYSERR_KEYNOTFOUND = 15
MMSYSERR_READERROR = 16
MMSYSERR_WRITEERROR = 17
MMSYSERR_DELETEERROR = 18
MMSYSERR_VALNOTFOUND = 19
MMSYSERR_NODRIVERCB = 20
WAVERR_BADFORMAT = 32
WAVERR_STILLPLAYING = 33
WAVERR_UNPREPARED = 34
End Enum
<DllImport("winmm.dll", SetLastError:=True)>
Public Shared Function midiOutGetDevCaps(ByVal uDeviceID As UIntPtr, ByRef lpMidiOutCaps As MIDIOUTCAPS, ByVal cbMidiOutCaps As UInteger) As MMRESULT
End Function
<StructLayout(LayoutKind.Sequential)>
Public Structure MIDIOUTCAPS
Public wMid As UShort
Public wPid As UShort
Public vDriverVersion As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)>
Public szPname As String
Public wTechnology As UShort
Public wVoices As UShort
Public wNotes As UShort
Public wChannelMask As UShort
Public dwSupport As UInteger
End Structure
Private Sub form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim outDevs = midiOutGetNumDevs()
For index = 0 To outDevs - 1
Dim caps As MIDIOUTCAPS = New MIDIOUTCAPS()
midiOutGetDevCaps(DirectCast(index, UIntPtr), caps, Marshal.SizeOf(GetType(MIDIOUTCAPS)))
' do something with the caps object here, e.g.:
Console.WriteLine(caps.szPname)
Next
End Sub
-
Mar 1st, 2021, 02:00 PM
#3
Thread Starter
New Member
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
Thank you Dday9 for your help and fast answer.
I have followed the links you gave me. I already knew this code and have tryed it with some variations. The problem was always the same : empty structure.
Now I am trying to run the code you have posted for me. I get a lot of errors but I have been able to fix some. Tonight 9 errors remain, I will try to fix it tomorow.
Best regards.
-
Mar 1st, 2021, 02:03 PM
#4
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
What are the errors? I may be able to help you debug them.
-
Mar 2nd, 2021, 03:30 AM
#5
Thread Starter
New Member
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
Hello.
The errors existed because I had not written the "import" instructions at the begining of the code.
Now, only one error remains. The error is in the line "Dim outDevs = midiOutGetNumDevs()"
The error message tells me that the function is not declared.
Thank you very much for your help.
-
Mar 2nd, 2021, 03:43 AM
#6
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
in the same ways than for the function midiOutGetDevCaps
you need to add something like that
Code:
<DllImport("winmm.dll", SetLastError:=True)>
Public shared function midiOutGetNumDevs() as unint
end function
The best friend of any programmer is a search engine
"Don't wish it was easier, wish you were better. Don't wish for less problems, wish for more skills. Don't wish for less challenges, wish for more wisdom" (J. Rohn)
“They did not know it was impossible so they did it” (Mark Twain)
-
Mar 2nd, 2021, 04:36 AM
#7
Thread Starter
New Member
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
I have added the declaration of th API but the error remains but with a new error message "impossible to cast integer to UinPtr"
So, I have replaced "UinPtr" by "Integer" in the line " midiOutGetDevCaps(DirectCast(index, Integer), caps, Marshal.SizeOf(GetType(MIDIOUTCAPS)))"
And now everything is OK. IT WORKS
THANK YOU VERY MUCH FOR YOUR VERY USEFUL HELP
-
Mar 2nd, 2021, 05:14 AM
#8
Thread Starter
New Member
Re: VB2019 Need help : MIDIOUTGETDEVCAPS API returns 0 error but does not work.
Here is the entire code for VB 2019. It works very well, thanks to Dday9's help.
I post the code here because it may be useful for somebody else.
Code:
Option Explicit On
Option Strict Off
Imports System.Drawing.Bitmap
Imports System
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Collections.Specialized
Public Class Form1
Public Enum MMRESULT
MMSYSERR_NOERROR = 0
MMSYSERR_ERROR = 1
MMSYSERR_BADDEVICEID = 2
MMSYSERR_NOTENABLED = 3
MMSYSERR_ALLOCATED = 4
MMSYSERR_INVALHANDLE = 5
MMSYSERR_NODRIVER = 6
MMSYSERR_NOMEM = 7
MMSYSERR_NOTSUPPORTED = 8
MMSYSERR_BADERRNUM = 9
MMSYSERR_INVALFLAG = 10
MMSYSERR_INVALPARAM = 11
MMSYSERR_HANDLEBUSY = 12
MMSYSERR_INVALIDALIAS = 13
MMSYSERR_BADDB = 14
MMSYSERR_KEYNOTFOUND = 15
MMSYSERR_READERROR = 16
MMSYSERR_WRITEERROR = 17
MMSYSERR_DELETEERROR = 18
MMSYSERR_VALNOTFOUND = 19
MMSYSERR_NODRIVERCB = 20
WAVERR_BADFORMAT = 32
WAVERR_STILLPLAYING = 33
WAVERR_UNPREPARED = 34
End Enum
<DllImport("winmm.dll", SetLastError:=True)>
Public Shared Function midiOutGetDevCaps(ByVal uDeviceID As UIntPtr, ByRef lpMidiOutCaps As MIDIOUTCAPS, ByVal cbMidiOutCaps As UInteger) As MMRESULT
End Function
<StructLayout(LayoutKind.Sequential)>
Public Structure MIDIOUTCAPS
Public wMid As UShort
Public wPid As UShort
Public vDriverVersion As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)>
Public szPname As String
Public wTechnology As UShort
Public wVoices As UShort
Public wNotes As UShort
Public wChannelMask As UShort
Public dwSupport As UInteger
End Structure
' API counting the number of MidiOut ports
Public Declare Function midiOutGetNumDevs Lib "winmm.dll" () As Integer
Private Sub form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim outDevs = midiOutGetNumDevs()
For index = 0 To outDevs - 1
Dim caps As MIDIOUTCAPS = New MIDIOUTCAPS()
midiOutGetDevCaps(DirectCast(index, Integer), caps, Marshal.SizeOf(GetType(MIDIOUTCAPS)))
Label1.Text = caps.wMid
Label2.Text = caps.wPid
Label3.Text = caps.vDriverVersion
Label4.Text = caps.szPname
Label5.Text = caps.wTechnology
Label6.Text = caps.wVoices
Label7.Text = caps.wNotes
Label8.Text = caps.wChannelMask
Label9.Text = caps.dwSupport
Next
End Sub
End Class
Last edited by dday9; Mar 2nd, 2021 at 09:29 AM.
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|