Attribute VB_Name = "MCI"
Option Explicit

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
        (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
         ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
        (ByVal dwError As Long, ByVal lpstrBuffer As String, _
         ByVal uLength As Long) As Long

Function WavePlay() As String
'plays the recoreded sound aliased by mysound1
Dim ret As Long
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024

    ret = mciSendString("play mysound1 from 1 wait", ReturnString, 1024, 0)
    If ret <> 0 Then
        ret = mciGetErrorString(ret, ErrorString, 1024)
        WavePlay = Trim(ErrorString)
    End If
    
End Function

Function WaveRecord(nLengthMS As Long) As String
'records sound aliased as mysound1 to memory for nLengthMS seconds
    Dim ret As Long
    Dim ReturnString As String * 1024
    Dim ErrorString As String * 1024

    Call WaveClose

    ret = mciSendString("open new type waveaudio alias mysound1", ReturnString, 1024, 0)
    If ret <> 0 Then
        ret = mciGetErrorString(ret, ErrorString, 1024)
        WaveRecord = Trim(ErrorString)
        Exit Function
    End If

    ret = mciSendString("set mysound1 time format ms bitspersample 8 samplespersec 11025", ReturnString, 1024, 0)
    If ret <> 0 Then
        ret = mciGetErrorString(ret, ErrorString, 1024)
        WaveRecord = Trim(ErrorString)
        Exit Function
    End If

'Record for 4000 milliseconds (4 seconds)
    ret = mciSendString("record mysound1 to " & Str(nLengthMS), ReturnString, 1024, 0)
    If ret <> 0 Then
        ret = mciGetErrorString(ret, ErrorString, 1024)
        WaveRecord = Trim(ErrorString)
        Exit Function
    End If
End Function

Function WaveStop() As String

Dim ret As Long
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024
    
    ret = mciSendString("stop mysound1", ReturnString, 1024, 0)
    If ret <> 0 Then
      ret = mciGetErrorString(ret, ErrorString, 1024)
      WaveStop = ErrorString
    End If

End Function

Function WaveClose()

    Dim ret As Long
    Dim ReturnString As String * 1024

    ret = mciSendString("close mysound1", ReturnString, 1024, 0)

End Function

Function WaveCanPlay() As Boolean

Dim msg As String * 255
Dim ret As Long

  ret = mciSendString("capability mysound1 can play", msg, 255, 0)
  If Left$(LCase(msg), 4) = "true" Then
    WaveCanPlay = True
  Else
    WaveCanPlay = False
  End If

End Function


