CALLING NUMBERS IN VB6 using wav file +APIs
The following APIs were used in an application developed in VB5 and compiled in Win98 to read out call numbers from a doctor’s console to patients waiting at the doctor's reception
Public Declare Function mciSendStringA Lib "WinMM" _
(ByVal mciCommand As String, ByVal returnStr As String, _
ByVal returnLength As Integer, ByVal callBack As Integer) As Long
Public Declare Function mciGetErrorStringA Lib "WinMM" _
(ByVal Error As Long, ByVal buffer As String, _
ByVal length As Integer) As Integer
========================================================
This routine failed in windows XP and showed an error which I reported to Microsoft
I could not find an API by this name in XP and so I used the ones from Windows 98
When I called the routine, it would read out the first patient’s number satisfactorily but a second attempt would read out this error and hang up my system waiting for the 3 finger salute (control-alt-delete)
“The instruction at ‘0x7473d1d0’ referenced memory at “0x000000 10”The memory could not be read.
Click OK to terminate the program”
Numbers assigned to patients fall between 1 and 100
the routine that called patients worke perfectly in windows 98
but reported this error in WIndowsXp
The procedure that called a patient assigned a number 1 -100
Private Sub cmdCallPatient_Click()
Dim errorCode As Integer
Dim returnStr As Integer
Dim returnCode As Integer
Dim errorStr As String * 256
Dim number As Long
If Val(txtTallyNumber.Text) < 0 Or Val(txtTallyNumber.Text) > 100 Then Exit Sub
'Open file numbers.txt
errorCode = mciSendStringA("open numbers.wav type waveaudio alias numbers", _
returnStr, 255, 0)
returnCode = mciGetErrorStringA(errorCode, errorStr, 255)
ReadNum Val(txtTallyNumber.Text)
End Sub
\\\
FUNCTIONS THAT USE THE APIs
Public Sub ReadSingle(number)
Dim errorCode As Integer
Dim returnStr As Integer
Dim returnCode As Integer
Dim errorStr As String * 256
If number = 1 Then
errorCode = mciSendStringA("play numbers from 500 to 1500 wait", returnStr, 255, 0)
ElseIf number = 2 Then
errorCode = mciSendStringA("play numbers from 1500 to 2500 wait", returnStr, 255, 0)
ElseIf number = 3 Then
errorCode = mciSendStringA("play numbers from 2500 to 3500 wait", returnStr, 255, 0)
ElseIf number = 4 Then
errorCode = mciSendStringA("play numbers from 3500 to 4500 wait", returnStr, 255, 0)
ElseIf number = 5 Then
errorCode = mciSendStringA("play numbers from 4500 to 5500 wait", returnStr, 255, 0)
ElseIf number = 6 Then
errorCode = mciSendStringA("play numbers from 5500 to 6500 wait", returnStr, 255, 0)
ElseIf number = 7 Then
errorCode = mciSendStringA("play numbers from 6500 to 7500 wait", returnStr, 255, 0)
ElseIf number = 8 Then
errorCode = mciSendStringA("play numbers from 7500 to 8500 wait", returnStr, 255, 0)
ElseIf number = 9 Then
errorCode = mciSendStringA("play numbers from 8500 to 9500 wait", returnStr, 255, 0)
ElseIf number = 10 Then
errorCode = mciSendStringA("play numbers from 9500 to 10500 wait", returnStr, 255, 0)
ElseIf number = 11 Then
errorCode = mciSendStringA("play numbers from 10500 to 11500 wait", returnStr, 255, 0)
ElseIf number = 12 Then
errorCode = mciSendStringA("play numbers from 11500 to 12500 wait", returnStr, 255, 0)
ElseIf number = 13 Then
errorCode = mciSendStringA("play numbers from 12500 to 13500 wait", returnStr, 255, 0)
ElseIf number = 14 Then
errorCode = mciSendStringA("play numbers from 13500 to 14500 wait", returnStr, 255, 0)
ElseIf number = 15 Then
errorCode = mciSendStringA("play numbers from 14500 to 15500 wait", returnStr, 255, 0)
ElseIf number = 16 Then
errorCode = mciSendStringA("play numbers from 15500 to 16500 wait", returnStr, 255, 0)
ElseIf number = 17 Then
errorCode = mciSendStringA("play numbers from 16500 to 17500 wait", returnStr, 255, 0)
ElseIf number = 18 Then
errorCode = mciSendStringA("play numbers from 17500 to 18500 wait", returnStr, 255, 0)
ElseIf number = 19 Then
errorCode = mciSendStringA("play numbers from 18500 to 19500 wait", returnStr, 255, 0)
End If
End Sub
Public Sub ReadTenths(number)
Dim errorCode As Integer
Dim returnStr As Integer
Dim returnCode As Integer
Dim errorStr As String * 256
If number = 20 Then
errorCode = mciSendStringA("play numbers from 20000 to 20500 wait", returnStr, 255, 0)
ElseIf number = 30 Then
errorCode = mciSendStringA("play numbers from 21000 to 21500 wait", returnStr, 255, 0)
ElseIf number = 40 Then
errorCode = mciSendStringA("play numbers from 22000 to 22500 wait", returnStr, 255, 0)
ElseIf number = 50 Then
errorCode = mciSendStringA("play numbers from 23000 to 23500 wait", returnStr, 255, 0)
ElseIf number = 60 Then
errorCode = mciSendStringA("play numbers from 24000 to 24700 wait", returnStr, 255, 0)
ElseIf number = 70 Then
errorCode = mciSendStringA("play numbers from 25000 to 25700 wait", returnStr, 255, 0)
ElseIf number = 80 Then
errorCode = mciSendStringA("play numbers from 26100 to 26700 wait", returnStr, 255, 0)
ElseIf number = 90 Then
errorCode = mciSendStringA("play numbers from 27400 to 27900 wait", returnStr, 255, 0)
End If
End Sub
'This is the routine to read numbers
Public Sub ReadNum(number)
Dim errorCode As Integer
Dim returnStr As Integer
Dim returnCode As Integer
Dim errorStr As String * 256
Dim tenth As Integer
Dim leftover As Integer
Dim hundred As Integer
Dim thousand As Integer
If number < 20 Then 'Reads unique numbers
ReadSingle (number)
ElseIf number < 100 Then 'Reads numbers less than 100
tenth = Fix(number / 10)
ReadTenths (tenth * 10)
leftover = number - (tenth * 10)
If leftover > 0 Then
ReadSingle (leftover)
End If
ElseIf number < 1000 Then 'Reads numbers between 100 and 999
hundred = Fix(number / 100)
ReadSingle (hundred)
errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
leftover = number - (hundred * 100)
If leftover > 0 Then
tenth = Fix(leftover / 10)
If tenth > 0 Then ReadTenths (tenth * 10)
leftover = number - (hundred * 100) - (tenth * 10)
If leftover > 0 Then
ReadSingle (leftover)
End If
End If
Else 'Reads number between 1000 and 9999
thousand = Fix(number / 1000)
ReadSingle (thousand)
errorCode = mciSendStringA("play numbers from 29500 to 30100 wait", returnStr, 255, 0)
leftover = number - (thousand * 1000)
If leftover > 0 Then
hundred = Fix(leftover / 100)
If hundred > 0 Then
ReadSingle (hundred)
errorCode = mciSendStringA("play numbers from 28500 to 28900 wait", returnStr, 255, 0)
End If
leftover = number - (thousand * 1000) - (hundred * 100)
If leftover > 0 Then
tenth = Fix(leftover / 10)
If tenth > 0 Then ReadTenths (tenth * 10)
leftover = number - (thousand * 1000) - (hundred * 100) - (tenth * 10)
If leftover > 0 Then
ReadSingle (leftover)
End If
End If
End If
End If
End Sub