Jump to content


Check out our Community Blogs

deepmadan

Member Since 12 May 2009
Offline Last Active Feb 14 2012 05:34 AM
-----

Topics I've Started

using winmm.dll functions in visual studio 2008

14 February 2012 - 05:34 AM

Hi,

I had just shifted from vb6 to visual studio 2008.
I want to use winmm.dll functions in vb2008. Below is the module code that i used in vb6.


'*****************************************************************************'                CONSTANT DECLARATIONS'*****************************************************************************Public Const CALLBACK_WINDOW = &H10000Public Const CALLBACK_FUNCTION = &H30000Public Const MMIO_READ = &H0Public Const MMIO_FINDCHUNK = &H10Public Const MMIO_FINDRIFF = &H20Public Const WM_DESTROY = &H2Public Const USR_OUTBLOCK = &H400 + 102Public Const MM_WOM_OPEN = &H3BB          '           /* waveform output */Public Const MM_WOM_CLOSE = &H3BCPublic Const MM_WOM_DONE = &H3BDPublic Const MM_WIM_OPEN = &H3BE                '   /* waveform input */Public Const MM_WIM_CLOSE = &H3BFPublic Const MM_WIM_DATA = &H3C0Public Const MMSYSERR_NOERROR = 0Public Const SEEK_CUR = 1Public Const SEEK_END = 2Public Const SEEK_SET = 0Public Const TIME_BYTES = &H4Public Const WHDR_DONE = &H1Public Const WAVE_FORMAT_PCM = 1Public Enum status  StatusOkay = 0  StatusError = 1  StatusDone = 2End Enum'*****************************************************************************'                STRUCTURE DECLARATIONS'*****************************************************************************Private Type mmioinfo    dwFlags As Long    fccIOProc As Long    pIOProc As Long    wErrorRet As Long    htask As Long    cchBuffer As Long    pchBuffer As String    pchNext As String    pchEndRead As String    pchEndWrite As String    lBufOffset As Long    lDiskOffset As Long    adwInfo(4) As Long    dwReserved1 As Long    dwReserved2 As Long    hmmio As LongEnd TypePrivate Type WAVEHDR    lpData As Long    dwBufferLength As Long    dwBytesRecorded As Long    dwUser As Long    dwFlags As Long    dwLoops As Long    lpNext As Long    Reserved As LongEnd TypePrivate Type WAVEINCAPS    wMid As Integer    wPid As Integer    vDriverVersion As Long    szPname As String * 32    dwFormats As Long    wChannels As Integer    wReserver1 As IntegerEnd TypePrivate Type WAVEOUTCAPS    wMid As Integer    wPid As Integer    vDriverVersion As Long    szPname As String * 32    dwFormats As Long    wChannels As Integer    wReserver1 As Integer    dwSupport As LongEnd TypePrivate Type WAVEFORMAT    wFormatTag As Integer    nChannels As Integer    nSamplesPerSec As Long    nAvgBytesPerSec As Long    nBlockAlign As Integer    wBitsPerSample As Integer    cbSize As IntegerEnd TypePrivate Type MMCKINFO    ckid As Long    ckSize As Long    fccType As Long    dwDataOffset As Long    dwFlags As LongEnd TypePrivate Type MMTIME    wType As Long    u As Long    X As LongEnd Type'*****************************************************************************'                FUNCTION DECLARATIONS'*****************************************************************************Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As Long, lpInfo As MMTIME, ByVal uSize As Long) As LongDeclare Function waveOutOpen Lib "winmm.dll" (hWaveOut As Long, ByVal uDeviceID As Long, format As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongDeclare Function waveInOpen Lib "winmm.dll" (hWaveIn As Long, ByVal uDeviceID As Long, format As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongDeclare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As LongDeclare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As LongDeclare Function waveOutGetVolume Lib "winmm.dll" (ByVal hWaveOut As Long, pdwVolume As Long) As LongDeclare Function waveOutSetVolume Lib "winmm.dll" (ByVal hWaveOut As Long, pdwVolume As Long) As LongDeclare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As LongDeclare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As LongDeclare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As LongDeclare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As LongDeclare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As LongDeclare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As LongDeclare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As LongDeclare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As LongDeclare Function waveOutGetNumDevs Lib "winmm.dll" () As LongDeclare Function waveInGetNumDevs Lib "winmm.dll" () As LongDeclare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As LongDeclare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As LongDeclare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As LongDeclare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As MMCKINFO, ByVal uFlags As Long) As LongDeclare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal X As Long, ByVal uFlags As Long) As LongDeclare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As mmioinfo, ByVal dwOpenFlags As Long) As LongDeclare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, ByVal pch As Long, ByVal cch As Long) As LongDeclare Function mmioReadString Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As Long, ByVal pch As String, ByVal cch As Long) As LongDeclare Function mmioSeek Lib "winmm.dll" (ByVal hmmio As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As LongDeclare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As LongDeclare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As LongDeclare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongDeclare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As LongDeclare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As LongDeclare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)Declare Sub CopyStructFromString Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As String, ByVal cb As Long)Declare Function PostWavMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef hdr As WAVEHDR) As LongDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByRef lparam As WAVEHDR) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'*****************************************************************************'                VARIABLE DECLARATIONS'*****************************************************************************Public Const GWL_WNDPROC = -4Dim lpPrevWndProc As LongConst NUM_BUFFERS = 5Const BUFFER_SECONDS = 0.1Dim hmmioIn As Long ' file handleDim dataOffset As Long ' start of audio data in wave fileDim audioLength As Long ' number of bytes in audio dataDim pFormat As Long ' pointer to wave formatDim formatBuffer As String * 50 ' buffer to hold the wave formatDim startPos As Long ' sample where we started playback fromDim format As WAVEFORMAT ' waveformat structureDim i As Long ' loop control variableDim j As Long ' loop control variableDim hmem(1 To NUM_BUFFERS) As Long ' memory handlesDim pmem(1 To NUM_BUFFERS) As Long ' memory pointersDim hdr(1 To NUM_BUFFERS) As WAVEHDR ' wave headersDim bufferSize As Long ' size of output buffersDim fPlaying As Boolean ' is file currently playingDim fFileOpen As Boolean ' is file currently openDim msg As String * 250 ' message bufferDim hwnd As Long ' window handle'**********************************************Public wwh(64) As WAVEHDRPublic hWaveOut As Long ' waveout handlePublic hWaveIn As Long 'wavein handlePublic Flip As LongPublic RFlip As LongPublic TxBuf(16384) As BytePublic RxBuf(16384) As BytePublic TxFptr As Long, TxEptr As Long, TxCount As LongPublic RxFptr As Long, RxEptr As Long, RxCount As LongPublic rc As Long ' Return codePublic eStatus As statusPublic MuteTimer As LongPublic cc As LongPublic AudioOutMedia As StringPublic AudioInMedia As StringPublic AudioOutLevel As IntegerPublic AudioInLevel As Integer'*****************************************************************************'*****************************************************************************Public Function HIWORD(ByVal dwValue As Long) As Long  'on error Resume Next   Call CopyMemory(HIWORD, ByVal VarPtr(dwValue) + 2, 2)End FunctionPublic Function LOWORD(ByVal dwValue As Long) As Long  'on error Resume Next   Call CopyMemory(LOWORD, dwValue, 2)End FunctionPublic Function MAKELONG(ByVal wLow As Long, ByVal wHi As Long) As Long  'on error Resume Next    If (wHi And &H8000&) Then        MAKELONG = (((wHi And &H7FFF&) * 65536) Or (wLow And &HFFFF&)) Or &H80000000    Else        MAKELONG = LOWORD(wLow) Or (&H10000 * LOWORD(wHi))    End IfEnd FunctionPublic Sub SoundInit()  Dim i As Integer 'on error Resume Next   For i = 0 To 31    wwh(i).lpData = VarPtr(TxBuf(i * 512))    wwh(i).dwBufferLength = 512    wwh(i + 32).lpData = VarPtr(RxBuf(i * 512))    wwh(i + 32).dwBufferLength = 512  Next       TestOpenOutputDevice  waveOutPause (hWaveOut)  TestOpenInputDevice  waveOutRestart (hWaveOut)End SubPublic Function TestOpenOutputDevice() As Boolean    Dim woc As WAVEOUTCAPS    Dim wfx As WAVEFORMAT    Dim nDevId As Long    Dim nMaxDevices  As Long    Dim i As Integer    Dim ss As String    Dim found As Boolean    Dim lvol As Long, rvol As Long  'on error Resume Next        nMaxDevices = waveOutGetNumDevs        found = False    hWaveOut = 0    eStatus = StatusOkayfirst1:    For nDevId = 0 To nMaxDevices - 1       rc = waveOutGetDevCaps(nDevId, woc, Len(woc))       If rc = MMSYSERR_NOERROR Then                            i = InStr(1, woc.szPname, Chr$(0), vbBinaryCompare)          If i > 0 Then            ss = Trim(Left(woc.szPname, i - 1))          Else            ss = Trim(woc.szPname)          End If          If ss = AudioOutMedia Or found = True Then                        AudioOutMedia = ss            found = True                   ' ***************************            wfx.nChannels = 1           ' Mono            wfx.nSamplesPerSec = 8000   ' 8000' ***************************            wfx.wFormatTag = WAVE_FORMAT_PCM            wfx.wBitsPerSample = 8'           wfx.nBlockAlign     = wfx.nChannels * wfx.wBitsPerSample / 8'            wfx.nAvgBytesPerSec = wfx.nSamplesPerSec * wfx.nBlockAlign            wfx.nBlockAlign = 1            wfx.nAvgBytesPerSec = 8000            wfx.cbSize = 0            rc = waveOutOpen(hWaveOut, nDevId, wfx, AddressOf PlayProc, 0, CALLBACK_FUNCTION)                                                                 If Not rc = MMSYSERR_NOERROR Then             'MessageBox(NULL, "Waveoutopen error", NULL, MB_OK)             TestOpenOutputDevice = False           Else              'lvol = &HFFFF * (AudioOutLevel / 100)              'rvol = &HFFFF * (AudioOutLevel / 100)              'rc = waveOutSetVolume(hWaveOut, MAKELONG(lvol, rvol))                            Dim dwVol As Long              'set volume level to at least 80%              rc = waveOutGetVolume(hWaveOut, dwVol)              If rc = MMSYSERR_NOERROR Then                  If (LOWORD(dwVol) < &HCCCC) Or _                      (wfx.nChannels = 2 And HIWORD(dwVol) < &HCCCC) Then                      rc = waveOutSetVolume(hWaveOut, MAKELONG(&HCCCC, &HCCCC))                  End If              End If           End If           If Not rc = MMSYSERR_NOERROR Then TestOpenOutputDevice = False           GoTo last         End If       End If    Next    If found = False Then      MsgBox "Audio Output Media Error, Using Default Media", vbInformation       found = True       GoTo first1    End Iflast:    If hWaveOut = Null Then TestOpenOutputDevice = False    For i = 0 To 31       rc = waveOutPrepareHeader(hWaveOut, wwh(i), Len(wwh(i)))       rc = waveOutWrite(hWaveOut, wwh(i), Len(wwh(i)))    Next    Flip = 0    TestOpenOutputDevice = TrueEnd FunctionPublic Function TestOpenInputDevice() As Boolean    Dim wic As WAVEINCAPS    Dim wfx As WAVEFORMAT    Dim nDevId As Long    Dim nMaxDevices As Long    Dim i As Integer    Dim ss As String    Dim found As Boolean    Dim lvol As Long, rvol As Long 'on error Resume Next     nMaxDevices = waveInGetNumDevs        found = False    hWaveIn = 0    eStatus = StatusOkay     ' reset statusfirst1:    For nDevId = 0 To nMaxDevices - 1           rc = waveInGetDevCaps(nDevId, wic, Len(wic))       If rc = MMSYSERR_NOERROR Then                i = InStr(1, wic.szPname, Chr$(0), vbBinaryCompare)         If i > 0 Then           ss = Trim(Left(wic.szPname, i - 1))         Else           ss = Trim(wic.szPname)         End If         If ss = AudioInMedia Or found = True Then                        AudioInMedia = ss            found = True' ***************************            wfx.nChannels = 1           ' Mono            wfx.nSamplesPerSec = 8000   ' 8000' ***************************           wfx.wFormatTag = WAVE_FORMAT_PCM           wfx.wBitsPerSample = 8'           wfx.nBlockAlign     = wfx.nChannels * wfx.wBitsPerSample / 8'           wfx.nAvgBytesPerSec = wfx.nSamplesPerSec * wfx.nBlockAlign           wfx.nBlockAlign = 1           wfx.nAvgBytesPerSec = 8000           wfx.cbSize = 0           rc = waveInOpen(hWaveIn, nDevId, wfx, AddressOf waveInProc, 0, CALLBACK_FUNCTION)                                                                 If Not rc = MMSYSERR_NOERROR Then         '     MessageBox(NULL, "WaveInOpen error", NULL, MB_OK)             TestOpenInputDevice = False           Else              'Dim dwVol As Long              'set volume level to at least 80%              'rc = waveInGetVolume(hWaveIn, dwVol)              'If rc = MMSYSERR_NOERROR Then              '    If (LOWORD(dwVol) < &HCCCC) Or _              '        (wfx.nChannels = 2 And HIWORD(dwVol) < &HCCCC) Then              '        rc = waveInSetVolume(hWaveIn, MAKELONG(&HCCCC, &HCCCC))              '    End If              'End If           End If           GoTo last         End If       End If    Next    If found = False Then      MsgBox "Audio Input Media Error, Using Default Media", vbInformation      found = True      GoTo first1    End Iflast:    If hWaveIn = Null Then         '      MessageBox(NULL, "WaveInOpen error<1>", NULL, MB_OK)         TestOpenInputDevice = False    End If    For i = 0 To 31        rc = waveInPrepareHeader(hWaveIn, wwh(i + 32), Len(wwh(i + 32)))        rc = waveInAddBuffer(hWaveIn, wwh(i + 32), Len(wwh(i + 32)))    Next    RFlip = 0    TestOpenInputDevice = TrueEnd FunctionSub PlayProc(ByVal hWaveOut As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByVal dwParam1 As Long, lpwh As WAVEHDR)   Dim MMTIME As MMTIME 'on error Resume Next   'LPWAVEHDR lpwh = (LPWAVEHDR)dwParam2   'Dim lpwh As WAVEHDR   Select Case uMsg      Case MM_WOM_OPEN           ' cc = 0            eStatus = StatusOkay    '        break '/*end WM_INITDIALOG case*/      Case MM_WOM_CLOSE'         EndDialog(hDlg,0)          'break   '   Case WM_DESTROY   '           PostQuitMessage (0)              'break      Case MM_WOM_DONE               'cc = 1 '     Case USR_OUTBLOCK            MMTIME.wType = TIME_BYTES            If TxCount > 0 Then TxCount = TxCount - 1            If (eStatus = StatusOkay) Then               If (eStatus = StatusOkay) Then                     rc = waveOutPrepareHeader(hWaveOut, wwh(Flip), Len(wwh(Flip)))                     If Not (rc = MMSYSERR_NOERROR) Then                         'SetDlgItemText(hdlg0, ChStatus, "Prepare ERR")                         'break                         Exit Sub                     End If                     ' write buffers to the queue                     If (rc = MMSYSERR_NOERROR) Then                        rc = waveOutWrite(hWaveOut, wwh(Flip), Len(wwh(Flip)))                     End If                     If Not (rc = MMSYSERR_NOERROR) Then                         'StopPlayBackTest()  // free allocated memory                         waveOutPause (hWaveOut)                         'SetDlgItemText(hdlg0, ChStatus, "Write ERR")                         eStatus = StatusError                     End If               End If               Flip = Flip + 1               Flip = Flip And 31            End If   End SelectEnd SubSub waveInProc(ByVal hWaveIn As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByVal dwParam1 As Long, lpwh As WAVEHDR)  'on error Resume Next       Select Case uMsg      Case MM_WIM_OPEN      Case MM_WIM_CLOSE            ' /*end WM_INITDIALOG case*/      Case MM_WIM_DATA                   RxCount = RxCount + 1            RxFptr = RxFptr + 512            RxFptr = RxFptr And 16383            rc = waveInPrepareHeader(hWaveIn, wwh(RFlip + 32), Len(wwh(RFlip + 32)))            If Not (rc = MMSYSERR_NOERROR) Then                'SetDlgItemText(hdlg0, ChStatus, "Prepare Err")                'break                Exit Sub            End If            rc = waveInAddBuffer(hWaveIn, wwh(RFlip + 32), Len(wwh(RFlip + 32)))            If Not (rc = MMSYSERR_NOERROR) Then                'SetDlgItemText(hdlg0, ChStatus, "Add Buffer")                Exit Sub                'break            End If            RFlip = RFlip + 1            RFlip = RFlip And 31            'PostMessage(hwi, USR_INBLOCK, 0, wParam)    End SelectEnd SubPublic Sub WaveClose()  Dim i As Integer 'on error Resume Next    'CLOSING WAVEIN AFTER UNPREPARING HEADERS  waveInStop (hWaveIn)'  waveInReset (hWaveIn)  For i = 0 To 31     rc = waveInUnprepareHeader(hWaveIn, wwh(i + 32), Len(wwh(i + 32)))  Next  If Not hWaveIn = 0 Then waveInClose (hWaveIn)    'CLOSING WAVEOUT AFTER UNPREPARING HEADERS  waveOutPause (hWaveOut) ' waveOutReset (hWaveOut)  For i = 0 To 31       rc = waveOutUnprepareHeader(hWaveOut, wwh(i), Len(wwh(i)))  Next  If Not hWaveOut = 0 Then waveOutClose (hWaveOut)    For i = 0 To 31    wwh(i).lpData = 0    wwh(i).dwBufferLength = 0    wwh(i + 32).lpData = 0    wwh(i + 32).dwBufferLength = 0  Next  End Sub






is there any similar module available for vb2008 or i need to copy all the code and remove all compatibility issues.??

Thanks in advance

WinSock in VB6 (SendData Problem)

27 July 2011 - 01:15 AM

I am developing an application in VB6 which will communicate using UDP Connection to a hardware which recieves and sends data using UDP Connection. My Hardware works fine. It has already been tested with an application written in VisualC using UDP connection only. In VisualC, I had working on UDP Connection without Winsock.
Hardware's Remote IP and Port is been set to my computer's IP and Port 4040.


My code for connection and sending data is as below :


If Winsock1.State = sckClosed Then
   Winsock1.Protocol = sckUDPProtocol
   Winsock1.LocalPort = 4040    
   Winsock1.RemoteHost = "192.168.1.80"  'Hardware IP
   Winsock1.RemotePort = 4040               'Hardware's Port
   Winsock1.connect
   Winsock1.SendData "Hello"
Else
   Winsock1.Close
End If


I debugged this code and also the hardware and i found that
1. A Packet is sent to the hardware after WinSock1.connect command is executed.
2. But no Packet is been send after SendData Command as it requires Winsock1 in Connected State.


I want to know if i could senddata using winsock without my connection being accepted by the remote machine(hardware).
I am even able to recieve messages from Hardware on the DataArrival Function.

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download