Oppure

Loading
03/09/09 11:33
orma674
Ciao a tutti,
ho creato un programmino per acquisire i messaggi midi di lunghi (SysEx) da periferiche midi. Questo funziona in fase di debug ma quando creo il file eseguibile questo mi da errore. La funzione che chiamo in callback all'apertura del device midi è la seguente

Public Sub fMidiIn_Proc(ByVal hmIN As Long, ByVal wMsg As Long, ByVal dwInstance As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long)
Dim ct As Integer
Dim mimdata As String
Dim ret As Integer

Dim tShortMsg As String
Dim tByte0 As String
Dim tByte1 As String
Dim tByte2 As String
Dim tByte3 As String

On Error Resume Next

Select Case wMsg
Case MM_MIM_OPEN ': MsgBox ("MidiIn Open";)
Case MM_MIM_CLOSE ': MsgBox ("MidiIn Close";)
'MidiIn_Hdr.dwFlags = MHDR_DONE '1
Case MM_MIM_DATA ': MsgBox ("DATA RECEIVED";)
If dwParam1 > 0 Then tShortMsg = Right("00000000" & hex(dwParam1), 8)
' Pack the data into a Long variable
' Byte 3 = 00
tByte3 = Mid$(tShortMsg, 7, 2)
' Byte 2 = Volume
tByte2 = Mid$(tShortMsg, 5, 2)
' Byte 1 = Note
tByte1 = Mid$(tShortMsg, 3, 2)
' Byte 0 (LSB) = Status
tByte0 = Mid$(tShortMsg, 1, 2)
mimdata = tByte0 & " - " & tByte1 & " - " & tByte2 & " - " & tByte3

Call tMidi.cMidiIn_RxMessage(MM_MIM_DATA, mimdata)
Case MM_MIM_LONGDATA
For ct = 0 To MidiIn_Hdr.dwBytesRecorded - 1
If MidiIn_String(ct) <> 247 Then 'not F7 EOX
mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct)) & " "
MidiIn_String(ct) = 0
Else
mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct))
MidiIn_String(ct) = 0
End If
Next ct
Call tMidi.cMidiIn_RxMessage(MM_MIM_LONGDATA, mimdata)

' If MidiIn_Hdr.dwBufferLength = 0 Then Call fMidiIn_AddBuffer
Call fMidiIn_AddBuffer
Case MM_MIM_ERROR ': MsgBox ("ERROR";)
Case MM_MIM_LONGERROR ': MsgBox ("LONGERROR";)
Case Else
End Select
End Sub

Ovviamente prima di aprire di avviare il MidiIn, preparo il tutto per la ricezione del buffer. Il codice è abbastanza lungo per questo non lo invio tutto e mi limito alla sola funzione di callback.
Grazie per la collaborazione.
aaa
03/09/09 13:02
GrG
che errore ti da?

comunque rimuovi gli "On error resume next" per sapere che errori ci sono...
aaa
04/09/09 10:44
orma674
Si è verificato un errore in prjMidi.exe. L'applicazione verrà chiusa.

AppName: prjmidi.exe     AppVer: 9.8.0.12     ModName: msvbvm60.dll
2     Offset: 000e47f2

ModVer: 6.0.98.<?xml version="1.0" encoding="UTF-16"?>

<DATABASE>
<EXE NAME="prjMidi.exe" FILTER="GRABMI_FILTER_PRIVACY">
<MATCHING_FILE NAME="prjMidi.exe" SIZE="40960" CHECKSUM="0xC0E5FAB4" BIN_FILE_VERSION="9.8.0.12" BIN_PRODUCT_VERSION="9.8.0.12" PRODUCT_VERSION="9.08.0012" PRODUCT_NAME="prjMidi" FILE_VERSION="9.08.0012" ORIGINAL_FILENAME="prjMidi.exe" INTERNAL_NAME="prjMidi" VERFILEDATEHI="0x0" VERFILEDATELO="0x0" VERFILEOS="0x4" VERFILETYPE="0x1" MODULE_TYPE="WIN32" PE_CHECKSUM="0x14E93" LINKER_VERSION="0x90008" UPTO_BIN_FILE_VERSION="9.8.0.12" UPTO_BIN_PRODUCT_VERSION="9.8.0.12" LINK_DATE="09/01/2009 10:02:10" UPTO_LINK_DATE="09/01/2009 10:02:10" VER_LANGUAGE="Italiano (Italia) [0x410]" />
</EXE>

<EXE NAME="MSVBVM60.DLL" FILTER="GRABMI_FILTER_THISFILEONLY">
<MATCHING_FILE NAME="msvbvm60.dll" SIZE="1384479" CHECKSUM="0x9B6CFFE5" BIN_FILE_VERSION="6.0.98.2" BIN_PRODUCT_VERSION="6.0.98.2" PRODUCT_VERSION="6.00.9802" FILE_DESCRIPTION="Visual Basic Virtual Machine" COMPANY_NAME="Microsoft Corporation" PRODUCT_NAME="Visual Basic" FILE_VERSION="6.00.9802" INTERNAL_NAME="MSVBVM60.DLL" LEGAL_COPYRIGHT="Copyright © 1987-2000 Microsoft Corp." VERFILEDATEHI="0x0" VERFILEDATELO="0x0" VERFILEOS="0x4" VERFILETYPE="0x2" MODULE_TYPE="WIN32" PE_CHECKSUM="0x1547CE" LINKER_VERSION="0x0" UPTO_BIN_FILE_VERSION="6.0.98.2" UPTO_BIN_PRODUCT_VERSION="6.0.98.2" LINK_DATE="04/14/2008 02:15:18" UPTO_LINK_DATE="04/14/2008 02:15:18" VER_LANGUAGE="Inglese (Stati Uniti) [0x409]" />
</EXE>

<EXE NAME="kernel32.dll" FILTER="GRABMI_FILTER_THISFILEONLY">
<MATCHING_FILE NAME="kernel32.dll" SIZE="1033728" CHECKSUM="0x81070244" BIN_FILE_VERSION="5.1.2600.5781" BIN_PRODUCT_VERSION="5.1.2600.5781" PRODUCT_VERSION="5.1.2600.5781" FILE_DESCRIPTION="DLL client di Windows NT BASE API" COMPANY_NAME="Microsoft Corporation" PRODUCT_NAME="Sistema operativo Microsoft® Windows®" FILE_VERSION="5.1.2600.5781 (xpsp_sp3_gdr.090321-1317)" ORIGINAL_FILENAME="kernel32" INTERNAL_NAME="kernel32" LEGAL_COPYRIGHT="© Microsoft Corporation. Tutti i diritti riservati." VERFILEDATEHI="0x0" VERFILEDATELO="0x0" VERFILEOS="0x40004" VERFILETYPE="0x2" MODULE_TYPE="WIN32" PE_CHECKSUM="0xFF227" LINKER_VERSION="0x50001" UPTO_BIN_FILE_VERSION="5.1.2600.5781" UPTO_BIN_PRODUCT_VERSION="5.1.2600.5781" LINK_DATE="03/21/2009 14:06:59" UPTO_LINK_DATE="03/21/2009 14:06:59" VER_LANGUAGE="Italiano (Italia) [0x410]" />
</EXE>
</DATABASE>
aaa
04/09/09 10:50
orma674
GrG ho provato a togliere On Error Resume Next, ma non mi evidenzia codice di errore. L'errore che da è quello del post precedente.

Voglio evidenziare il fatto che l'esecuzione dal progetto in vb non mi da errore, l'errore è dato quando faccio girare il programma da file exe.

Grazie per la collaborazione.
aaa
04/09/09 12:40
GrG
eh... a volte capita, questo è uno dei difetti di vb. Può succedere che se esguito nell'ide non dia problemi invece se esguito apparte si.

Purtroppo qui ci vorrebbe qualcuno molto più esperto di me che ti controlli per intero il tuo progetto, perchè di sicuro c'è qualche riga di codice da cambiare.

Come unico consiglio per aiutarti nell'individuazione della riga che causa questo difetto è quello di mettere nel codice delle msgbox per capire dove risiede il problema. ti faccio un esempio per capire meglio.

Mettiamo che hai un codice di 6 righe.

aaaaa
bbbbb
ccccc
ddddd
eeeee
fffff

allora per iniziare mettiamo 2 msgbox

aaaaa
bbbbb
ccccc
msgbox "metà"
ddddd
eeeee
fffff

se compare la msgbox e poi viene l'errore signifa che la riga incriminata si trova nel "2° blocco" altrimenti se viene subito l'errore senza msgbox significa che si trova nel "1° blocco". Prendiamo in considerazione quest'ultimo caso.
Allora modificheremo il codice in questo modo

aaaaa
msgbox "1° riga ok"
bbbbb
msgbox "2° riga ok"
ccccc
msgbox "metà"
ddddd
eeeee
fffff

adesso basta vedere fino a quale msgbox arriva. Metti che dopo il msgbox "2° riga ok" viene l'errore significa allora che "cccccc" è la riga che causa il problema....
aaa
04/09/09 15:00
orma674
Ho provato a ridurre la funzione di callback per invididuare l'errore.

Public Sub fMidiIn_Proc(ByVal hmIN As Long, ByVal wMsg As Long, ByVal dwInstance As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long)
Dim ct As Integer
Dim mimdata As String
Dim ret As Integer

Dim tShortMsg As String
Dim tByte0 As String
Dim tByte1 As String
Dim tByte2 As String
Dim tByte3 As String

On Error Resume Next

Select Case wMsg
Case MM_MIM_OPEN ': MsgBox ("MidiIn Open";)
Case MM_MIM_CLOSE ': MsgBox ("MidiIn Close";)
Case MM_MIM_DATA ': MsgBox ("DATA RECEIVED";)
Case MM_MIM_LONGDATA
For ct = 0 To MidiIn_Hdr.dwBytesRecorded - 1
If MidiIn_String(ct) <> 247 Then 'not F7 EOX
' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct)) & " "
MidiIn_String(ct) = 0
Else
' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct))
MidiIn_String(ct) = 0
End If
Next ct
' Call tMidi.cMidiIn_RxMessage(MM_MIM_LONGDATA, mimdata)

' If MidiIn_Hdr.dwBufferLength = 0 Then Call fMidiIn_AddBuffer
' Call fMidiIn_AddBuffer
Case MM_MIM_ERROR ': MsgBox ("ERROR";)
Case MM_MIM_LONGERROR ': MsgBox ("LONGERROR";)
Case Else
End Select
End Sub

In questo modo non mi da errore ma ovviamente non visualizza i messaggi ricevuti, anche se elabora il ciclo per la lunghezza del buffer. Non appena tolgo l'apice ad una delle seguenti stringhe mi da errore.

' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct)) & " "

' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct))

' Call tMidi.cMidiIn_RxMessage(MM_MIM_LONGDATA, mimdata)

' Call fMidiIn_AddBuffer

Grazie per la collaborazione.
aaa
04/09/09 15:08
GrG
Postato originariamente da orma674:

' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct)) & " "

' mimdata = mimdata & Mid$("00", 1, 2 - Len(hex(MidiIn_String(ct)))) & hex(MidiIn_String(ct))

' Call tMidi.cMidiIn_RxMessage(MM_MIM_LONGDATA, mimdata)

' Call fMidiIn_AddBuffer


Quindi tu dici che sono queste quattro stringhe che danno errore? comunque le ultime 2 richiamano altre sub/funzioni quindi devi controllare anche all'interno delle sub/funzioni richiamate per individuare le stringhe precise...

e vedo anche che per le prime due usi una funzione MidiIn_String() dovresti controllare se è questa che causa problemi...
aaa
04/09/09 15:24
orma674
Ho provato ad aggiungere la chiamata ad una funzione pubblica delle Api, lasciando gli apici alle 4 stringhe.

ret = midiInAddBuffer(MidiIn_Handle, MidiIn_Hdr, LenB(MidiIn_Hdr))

Mi da lo stesso identico errore.
aaa