Getting Visual Basic 6 API mciSendString to really work

Recording sound using the API and mciSendString with Visual Basic 6
A method that really works (completely)

Getting mciSendString to work properly can be a tremendous headache. While writing a program, I needed to use the API to access the win.mm.dll library (mciSendString) to record sound in a format that Microsoft's Media player would play without errors. After struggling with conflicting advice from various web sites, and practically no useful information from Microsoft's site, I took it upon myself to dig a bit deeper.

My problem was that after I had figured out the correct information to make up the wave file header, I could not get Microsoft's Media player to play the file. I tried different orders for sending the information, different formulas, different coding techniques. I tried various versions of WMP without success (except for a really early version that has no version number attached to it). WinAmp and others played them without problems. Why couldn't I get WMP to play these files? What was missing?

In this tutorial I will attempt to explain what needs to be done to record wave files that will play correctly, regardless of which media player plays it. I never did find the solution on the net as I had hoped. I read the advice of many who suggested not using the API method at all, since it doesn't work correcly. I wanted to use it because it gives the user much more control. If you follow this tutorial, you will have to look no further.

The Problem

After a wave file is saved to your drive using VB's mciSendString, it does not play in Microsoft's Media Players. I have found that this is because the bytes-per-sec value is always written to the file incorrectly.
The byte depiction on the left represents a bad file. Note the yellow highlighted bytes. In the bad file, the hex values are 11 2B 00 which translates to 11025 decimal (these bytes are read in reverse order). The decimal value for this should be 176400 because this was recorded at 2 channels, 16 bit, 44100 samples: 44100 *( (2 * 16) / 8) However mciSendString always puts 11025 as the value. My solution is to directly change the file after it has been recorded. The byte depiction on the right depicts the file after it has been corrected. The yellow highlighted hex values (in reverse order - 02 B1 10) now equal the correct value of 176400 and plays perfectly in Windows Media Player.

Here is the complete VB code (written for VB6) that codes all the steps for recording a wave file, and my solution for fixing that wave file so it is playable with all media players.

The code written here can be copied and pasted into your program. It is activated by command buttons on the main form. This code has been modified from the original, taking out features that interact with my full program to leave behind the essence of recording and fixing a wave file. Here's hoping it functions with a simple copy and paste. If you have any questions or problems, feel free to e-mail me.

' module modRecordWav

Option Explicit
Dim lBytes As Long ' I'm using this as a global variable since several procedures need it
' declare the functions used in the winmm.dll library
Private 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

Private Declare Function mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" _
(ByVal dwError As Long, _
ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
'________________________________________________

Public Function StartRecord(Soundfile As String, sChannels As String, sBits As String, sSamples As String) As Boolean
' this function gets called from a click of a button on the main form
' it passes the name of the wave file including the path,
' the number of channels (1 or 2),
' the number of bits (8 or 16),
' and the number of samples per second desired (standards are 11025, 22050, and 44100)
' the higher the sample number, the better the sound quality
' these are all passed as strings

' declare variables
Dim Result as long
Dim errormsg as integer
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024
Dim mssg As String * 255
Dim i As Long
Dim BlockAlign As Integer
Dim sBytes As String
' make sure all working files in memory are closed
mciSendString "close all", 0, 0, 0
' open a ned working file in memory - recsound is my name for this working file
Result= mciSendString("open new Type waveaudio Alias recsound", ReturnString, Len(ReturnString), 0)
' this result check will be performed after EVERY mciSendString to make sure it does not
' generate any errors
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error"
End If
' set time format to milliseconds
Result= mciSendString("set recsound time format ms", ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (time format)"
End If
' set to pcm type wave file (Microsoft standard)
Result= mciSendString("set recsound format tag pcm", ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (format tag)"
End If

' in these next settings make sure there is a space between the setting and the setting variable
' set number of channels (1 or 2) - variable sChannels passed from calling procedure
Result= mciSendString("set recsound channels " & sChannels, ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (channels)"
End If

' set number of samples - variable sSamples passed from calling procedure
Result& = mciSendString("set recsound samplespersec " & sSamples", ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (samples/sec)"
End If

' set number of bits (8 or 16) - - variable sBits passed from calling procedure
Result= mciSendString("set recsound bitspersample " & sBits, ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (bits/sample)"
End If

' set the block allignment - I don't think this is necessary but
' is included just in case, and for completeness
' formula to find block allignment
BlockAlign = CInt((CLng(sBits) / 8) * CLng(sChannels))
Result= mciSendString("set recsound alignment " & Str$(BlockAlign), ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (block align)"
End If

' calculates OK but mciSendString does not put it in the wav file properly
' will always put 11025 regardless of what it is supposed to be
' this value is ONLY good for 1 channel, 8 bits, 11025 samples
' this is where WMP stumbles - we'll address this further on
' we'll include this anyway so you can see where the error actually lies

lBytes = CLng(sSamples) * ((CLng(sChannels) * CLng(sBits)) / 8)
sBytes = Str$(lBytes)
' doesn't work correctly due to suspected bug in winmm.dll
' make sure this part of the code is commented out or you will get errors
' ************************************************
' Result= mciSendString("set recsound bytespersec " & sBytes, ReturnString, 1024, 0)
' If Not Result= 0 Then
' errormsg = mciGetErrorString(Result, ErrorString, 1024)
' MsgBox ErrorString, 0, "Error (bytes/sec)"
' End If

' start recording
Result= mciSendString("record recsound", ReturnString, Len(ReturnString), 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (record)"
End If
End Function
' __________________________________________________

Public Function StopRecord() As Boolean
' this function activated by stop command button on main form
Dim Result as Long
Dim errormsg as Integer
Dim ReturnString As String * 1024
Dim ErrorString As String * 1024
Dim mssg As String * 255
Dim i As Long

' stop the recording
Result = mciSendString("stop recsound", ReturnString, Len(ReturnString), 0)
If Not Result = 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (stop)"
End If

' save the wave file that is in memory
Result= mciSendString("save recsound C:\NewWav.wav", ReturnString, Len(ReturnString), 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (save)"
End If

' calls the procedure that will read back the values just recorded
' see these results to make the error show
Call GetRecStatus

' close the file in memory
Result= mciSendString("close recsound", ReturnString, 1024, 0)
If Not Result= 0 Then
errormsg = mciGetErrorString(Result, ErrorString, 1024)
MsgBox ErrorString, 0, "Error (close)"
End If

' make sure all files in memory are closed
mciSendString "close all", 0, 0, 0

' now call the procedure that fixes the file on your drive
Call FixWaveFile

End Function
' _______________________________________________________

Private Sub GetRecStatus()
' read the status of the file in memory
' declare variables
Dim i As Long
Dim MSchan As String
Dim MSbits As String
Dim MSsamples As String
Dim MSbytes As String
Dim lChan As Long
Dim lBits As Long
Dim lSamples As Long
'Dim lBytes As Long declared as global
Dim sChan As String
Dim mssg As String * 255

' channel status
i = mciSendString("status recsound channels", mssg, 255, 0)
If Str(mssg) = "1" Then
MSchan = "mono"
sChan = "1"
Else
MSchan = "stereo"
sChan = "2"
End If
Msgbox "channel =" & MSchan

' bits per sample
i = mciSendString("status recsound bitspersample", mssg, 255, 0)
MSbits = Str(mssg)
Msgbox "bits per sample =" & MSbits

'samples
i = mciSendString("status recsound samplespersec", mssg, 255, 0)
MSsamples = Str(mssg)
Msgbox "samples =" & MSsamples

' this reports 11025 regardless of how it was written! wrong! - fixed later
i = mciSendString("status recsound bytespersec", mssg, 255, 0)
MSbytes = Str(mssg)
Msgbox "bytes per sec=" & MSbytes

' calculate the real bytes per sec value
' this value will be used to fix the file after it has been saved
lBytes = CLng(MSsamples) * ((CLng(sChan) * CLng(MSbits)) / 8)

End Sub

' ____________________________________________________

Public Sub FixWaveFile()
' this will fix the file so it is playable with WMP
' declare integers
Dim Indexnum As Integer
Dim x As Integer
Dim HexCode As String
Dim Hex1 As String
Dim Hex2 As String
Dim Hex3 As String
Dim lByteNum As Long ' byte number (29,30, & 31) in the wave file
Dim bByte As Byte ' will be hex byte to write

' get the hexadecimal for the lBytes value
HexCode = Hex(lBytes) ' lBytes calculated from previous formula
Do While Len(HexCode) < 6 ' make sure the hex code is 6 chars long
HexCode = "0" & HexCode ' if not, add a zero
Loop

' note: this value had to be written to the file in reverse order!
Hex1 = Right$(HexCode, 2) ' Endian small - reverse order - get last hex byte first
Hex2 = Mid$(HexCode, 3, 2) ' get middle hex byte
Hex3 = Left$(HexCode, 2) ' get first hex byte

'open the file
Indexnum = FreeFile ' get a free file number
Open "C:\NewWav.wav" For Binary Access Write As #Indexnum ' binary open file
lByteNum = 29 ' first byte to write is 29
bByte = CInt("&H" & Hex1) ' bByte = integer of hex Hex1
Put #Indexnum, lByteNum, bByte 'write bByte value to byte position lByteNum in file
bByte = CInt("&H" & Hex2) ' proceed to write remaining two bytes to consecutive positions
lByteNum = lByteNum + 1
Put #Indexnum, lByteNum, bByte ' note the Put command for writing bites to binary files
bByte = CInt("&H" & Hex3)
lByteNum = lByteNum + 1
Put #Indexnum, lByteNum, bByte
Close #1
End Sub

_________________________________________________________________________

tutorial & VB code by S Clarke

Questions or comments can be sent to: Rediware

Thanks for visiting!