'*****************************************************************************
'                CONSTANT DECLARATIONS
'*****************************************************************************
Public Const CALLBACK_WINDOW = &H10000
Public Const CALLBACK_FUNCTION = &H30000
Public Const MMIO_READ = &H0
Public Const MMIO_FINDCHUNK = &H10
Public Const MMIO_FINDRIFF = &H20
Public Const WM_DESTROY = &H2
Public Const USR_OUTBLOCK = &H400 + 102

Public Const MM_WOM_OPEN = &H3BB          '           /* waveform output */
Public Const MM_WOM_CLOSE = &H3BC
Public Const MM_WOM_DONE = &H3BD
Public Const MM_WIM_OPEN = &H3BE                '   /* waveform input */
Public Const MM_WIM_CLOSE = &H3BF
Public Const MM_WIM_DATA = &H3C0

Public Const MMSYSERR_NOERROR = 0
Public Const SEEK_CUR = 1
Public Const SEEK_END = 2
Public Const SEEK_SET = 0
Public Const TIME_BYTES = &H4
Public Const WHDR_DONE = &H1
Public Const WAVE_FORMAT_PCM = 1

Public Enum status
  StatusOkay = 0
  StatusError = 1
  StatusDone = 2
End 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 Long
End Type

Private 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 Long
End Type

Private Type WAVEINCAPS
    wMid As Integer
    wPid As Integer
    vDriverVersion As Long
    szPname As String * 32
    dwFormats As Long
    wChannels As Integer
    wReserver1 As Integer
End Type

Private 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 Long
End Type

Private Type WAVEFORMAT
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
    cbSize As Integer
End Type

Private Type MMCKINFO
    ckid As Long
    ckSize As Long
    fccType As Long
    dwDataOffset As Long
    dwFlags As Long
End Type

Private Type MMTIME
    wType As Long
    u As Long
    X As Long
End Type

'*****************************************************************************
'                FUNCTION DECLARATIONS
'*****************************************************************************

Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As Long, lpInfo As MMTIME, ByVal uSize As Long) As Long
Declare 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 Long
Declare 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 Long
Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveOutReset Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Declare Function waveOutRestart Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal hWaveOut As Long, pdwVolume As Long) As Long
Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal hWaveOut As Long, pdwVolume As Long) As Long
Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long
Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long
Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, lpWaveHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As MMCKINFO, ByVal uFlags As Long) As Long
Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal X As Long, ByVal uFlags As Long) As Long
Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As mmioinfo, ByVal dwOpenFlags As Long) As Long
Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, ByVal pch As Long, ByVal cch As Long) As Long
Declare Function mmioReadString Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As Long, ByVal pch As String, ByVal cch As Long) As Long
Declare Function mmioSeek Lib "winmm.dll" (ByVal hmmio As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Declare 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 Long
Declare 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 Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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 = -4
Dim lpPrevWndProc As Long
Const NUM_BUFFERS = 5
Const BUFFER_SECONDS = 0.1
Dim hmmioIn As Long ' file handle
Dim dataOffset As Long ' start of audio data in wave file
Dim audioLength As Long ' number of bytes in audio data
Dim pFormat As Long ' pointer to wave format
Dim formatBuffer As String * 50 ' buffer to hold the wave format
Dim startPos As Long ' sample where we started playback from
Dim format As WAVEFORMAT ' waveformat structure
Dim i As Long ' loop control variable
Dim j As Long ' loop control variable
Dim hmem(1 To NUM_BUFFERS) As Long ' memory handles
Dim pmem(1 To NUM_BUFFERS) As Long ' memory pointers
Dim hdr(1 To NUM_BUFFERS) As WAVEHDR ' wave headers
Dim bufferSize As Long ' size of output buffers
Dim fPlaying As Boolean ' is file currently playing
Dim fFileOpen As Boolean ' is file currently open
Dim msg As String * 250 ' message buffer
Dim hwnd As Long ' window handle
'**********************************************
Public wwh(64) As WAVEHDR
Public hWaveOut As Long ' waveout handle
Public hWaveIn As Long 'wavein handle
Public Flip As Long
Public RFlip As Long
Public TxBuf(16384) As Byte
Public RxBuf(16384) As Byte
Public TxFptr As Long, TxEptr As Long, TxCount As Long
Public RxFptr As Long, RxEptr As Long, RxCount As Long
Public rc As Long ' Return code
Public eStatus As status
Public MuteTimer As Long
Public cc As Long
Public AudioOutMedia As String
Public AudioInMedia As String
Public AudioOutLevel As Integer
Public 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 Function

Public Function LOWORD(ByVal dwValue As Long) As Long
  'on error Resume Next
   Call CopyMemory(LOWORD, dwValue, 2)
End Function

Public 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 If
End Function

Public 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 Sub

Public 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 = StatusOkay
first1:
    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 If
last:
    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 = True

End Function

Public 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 status
first1:
    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 If
last:
    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 = True
End Function

Sub 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 Select
End Sub


Sub 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 Select
End Sub


Public 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