25
AUTOMATIC SYSTEM
AUDIO RECORDER ON VISUAL BASIC
Dushanbe, 2009
Main Interface
Source Code
Option Explicit
Copyright: E. de Vries
e-mail: eeltje@geocities.com
This code can be used as freeware
Const AppName = "AudioRecorder"
Private Sub cmdSave_Click ()
Dim sName As String
If WaveMidiFileName = "" Then
sName = "Radio_from_" & CStr (WaveRecordingStartTime) & "_to_" & CStr (WaveRecordingStopTime)
sName = Replace (sName, ": ", "-")
sName = Replace (sName, " ", "_")
sName = Replace (sName, "/", "-")
Else
sName = WaveMidiFileName
sName = Replace (sName, "MID", "wav")
End If
CommonDialog1. FileName = sName
CommonDialog1. CancelError = True
On Error GoTo ErrHandler1
CommonDialog1. Filter = "WAV file (*. wav*) |*. wav"
CommonDialog1. Flags = &p Or &H400
CommonDialog1. ShowSave
sName = CommonDialog1. FileName
WaveSaveAs (sName)
Exit Sub
ErrHandler1:
End Sub
Private Sub cmdRecord_Click ()
Dim settings As String
Dim Alignment As Integer
Alignment = Channels * Resolution / 8
settings = "set capture alignment " & CStr (Alignment) & " bitspersample " & CStr (Resolution) & " samplespersec " & CStr (Rate) & " channels " & CStr (Channels) & " bytespersec " & CStr (Alignment * Rate)
WaveReset
WaveSet
WaveRecord
WaveRecordingStartTime = Now
cmdStop. Enabled = True Enable the STOP BUTTON
cmdPlay. Enabled = False Disable the "PLAY" button
cmdSave. Enabled = False Disable the "SAVE AS" button
cmdRecord. Enabled = False Disable the "RECORD" button
End Sub
Private Sub cmdSettings_Click ()
Dim strWhat As String
show the user entry form modally
strWhat = MsgBox ("If you continue your data will be lost!", vbOKCancel)
If strWhat = vbCancel Then
Exit Sub
End If
Slider1. Max = 10
Slider1. Value = 0
Slider1. Refresh
cmdRecord. Enabled = True
cmdStop. Enabled = False
cmdPlay. Enabled = False
cmdSave. Enabled = False
WaveReset
Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025"))
Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1"))
Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16"))
WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: Radio. wav")
WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True")
WaveRecordingImmediate = True
WaveRecordingReady = False
WaveRecording = False
WavePlaying = False
Be sure to change the Value property of the appropriate button!!
if you change the default values!
WaveSet
frmSettings. optRecordImmediate. Value = True
frmSettings. Show vbModal
End Sub
Private Sub cmdStop_Click ()
WaveStop
cmdSave. Enabled = True Enable the "SAVE AS" button
cmdPlay. Enabled = True Enable the "PLAY" button
cmdStop. Enabled = False Disable the "STOP" button
If WavePosition = 0 Then
Slider1. Max = 10
Else
If WaveRecordingImmediate And (Not WavePlaying) Then Slider1. Max = WavePosition
If (Not WaveRecordingImmediate) And WaveRecording Then Slider1. Max = WavePosition
End If
If WaveRecording Then WaveRecordingReady = True
WaveRecordingStopTime = Now
WaveRecording = False
WavePlaying = False
frmSettings. optRecordProgrammed. Value = False
frmSettings. optRecordImmediate. Value = True
frmSettings. lblTimes. Visible = False
End Sub
Private Sub cmdPlay_Click ()
WavePlayFrom (Slider1. Value)
WavePlaying = True
cmdStop. Enabled = True
cmdPlay. Enabled = False
End Sub
Private Sub cmdWeb_Click ()
Dim ret&
ret& = ShellExecute (Me. hwnd, "Open", "http://home. wxs. nl/~eeltjevr/", "", App. Path,
1)
End Sub
Private Sub cmdReset_Click ()
Slider1. Max = 10
Slider1. Value = 0
Slider1. Refresh
cmdRecord. Enabled = True
cmdStop. Enabled = False
cmdPlay. Enabled = False
cmdSave. Enabled = False
WaveReset
Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025"))
Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1"))
Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16"))
WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: Radio. wav")
WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True")
WaveRecordingImmediate = True
WaveRecordingReady = False
WaveRecording = False
WavePlaying = False
WaveMidiFileName = ""
Be sure to change the Value property of the appropriate button!!
if you change the default values!
WaveSet
If WaveRenameNecessary Then
Name WaveShortFileName As WaveLongFileName
WaveRenameNecessary = False
WaveShortFileName = ""
End If
End Sub
Private Sub Form_Load ()
WaveReset
Rate = CLng (GetSetting ("AudioRecorder", "StartUp", "Rate", "110025"))
Channels = CInt (GetSetting ("AudioRecorder", "StartUp", "Channels", "1"))
Resolution = CInt (GetSetting ("AudioRecorder", "StartUp", "Resolution", "16"))
WaveFileName = GetSetting ("AudioRecorder", "StartUp", "WaveFileName", "C: Radio. wav")
WaveAutomaticSave = GetSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", "True")
WaveRecordingImmediate = True
WaveRecordingReady = False
WaveRecording = False
WavePlaying = False
Be sure to change the Value property of the appropriate button!!
if you change the default values!
WaveSet
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
WaveMidiFileName = ""
WaveRenameNecessary = False
End Sub
Private Sub Form_Unload (Cancel As Integer)
WaveClose
Call SaveSetting ("AudioRecorder", "StartUp", "Rate", CStr (Rate))
Call SaveSetting ("AudioRecorder", "StartUp", "Channels", CStr (Channels))
Call SaveSetting ("AudioRecorder", "StartUp", "Resolution", CStr (Resolution))
Call SaveSetting ("AudioRecorder", "StartUp", "WaveFileName", WaveFileName)
Call SaveSetting ("AudioRecorder", "StartUp", "WaveAutomaticSave", CStr (WaveAutomaticSave))
If WaveRenameNecessary Then
Name WaveShortFileName As WaveLongFileName
WaveRenameNecessary = False
WaveShortFileName = ""
End If
End
End Sub
Private Sub Timer2_Timer ()
Dim RecordingTimes As String
Dim msg As String
RecordingTimes = "Start time: " & WaveRecordingStartTime & vbCrLf _
& "Stop time: " & WaveRecordingStopTime
WaveStatistics
If Not WaveRecordingImmediate Then
WaveStatisticsMsg = WaveStatisticsMsg & "Programmed recording"
If WaveAutomaticSave Then
WaveStatisticsMsg = WaveStatisticsMsg & " (automatic save)"
Else
WaveStatisticsMsg = WaveStatisticsMsg & " (manual save)"
End If
WaveStatisticsMsg = WaveStatisticsMsg & vbCrLf & vbCrLf & RecordingTimes
End If
StatisticsLabel. Caption = WaveStatisticsMsg
WaveStatus
If WaveStatusMsg <> AudioRecorder. Caption Then AudioRecorder. Caption = WaveStatusMsg
If InStr (AudioRecorder. Caption, "stopped") > 0 Then
cmdStop. Enabled = False
cmdPlay. Enabled = True
End If
If RecordingTimes <> frmSettings. lblTimes. Caption Then frmSettings. lblTimes. Caption = RecordingTimes
If (Now > WaveRecordingStartTime) _
And (Not WaveRecordingReady) _
And (Not WaveRecordingImmediate) _
And (Not WaveRecording) Then
WaveReset
WaveSet
WaveRecord
WaveRecording = True
cmdStop. Enabled = True Enable the STOP BUTTON
cmdPlay. Enabled = False Disable the "PLAY" button
cmdSave. Enabled = False Disable the "SAVE AS" button
cmdRecord. Enabled = False Disable the "RECORD" button
End If
If (Now > WaveRecordingStopTime) And (Not WaveRecordingReady) And (Not WaveRecordingImmediate) Then
WaveStop
cmdSave. Enabled = True Enable the "SAVE AS" button
cmdPlay. Enabled = True Enable the "PLAY" button
cmdStop. Enabled = False Disable the "STOP" button
If WavePosition > 0 Then
Slider1. Max = WavePosition
Else
Slider1. Max = 10
End If
WaveRecording = False
WaveRecordingReady = True
If WaveAutomaticSave Then
WaveFileName = "Radio_from_" & CStr (WaveRecordingStartTime) & "_to_" & CStr (WaveRecordingStopTime)
WaveFileName = Replace (WaveFileName, ": ", ". ")
WaveFileName = Replace (WaveFileName, " ", "_")
WaveFileName = WaveFileName & ". wav"
WaveSaveAs (WaveFileName)
msg = "Recording has been saved" & vbCrLf
msg = msg & "Filename: " & WaveFileName
MsgBox (msg)
Else
msg = "Recording is ready" & vbCrLf
msg = msg & "Dont forget to save recording..."
MsgBox (msg)
End If
frmSettings. optRecordProgrammed. Value = False
frmSettings. optRecordImmediate. Value = True
End If
End Sub
Option Explicit
Private Sub cmdFileName_Click ()
WaveFileName = InputBox ("Filename: ", "Filename for automatic saving", WaveFileName)
End Sub
Private Sub cmdMidi_Click ()
CommonDialog2. CancelError = True
On Error GoTo ErrHandler1
CommonDialog2. Filter = "Midi file (*. mid*) |*. mid"
CommonDialog2. Flags = &p Or &H400
CommonDialog2. ShowOpen
WaveMidiFileName = CommonDialog2. FileName
WaveMidiFileName = GetShortName (WaveMidiFileName)
ErrHandler1:
End Sub
Private Sub cmdOke_Click ()
Unload Me
End Sub
Private Sub cmdStartTime_Click ()
Dim wrst As String
wrst = WaveRecordingStartTime
wrst = InputBox ("Enter start time recording", "Start time", wrst)
If wrst = "" Then Exit Sub
If Not IsDate (wrst) Then
MsgBox ("The date/time you entered was not valid!")
Else
String returned from InputBox is a valid time,
so store it as a date/time value in WaveRecordingStartTime.
If CDate (wrst) < Now Then
MsgBox ("Recording events in the past is not possible... ")
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
Else
WaveRecordingStartTime = CDate (wrst)
End If
If WaveRecordingStopTime < WaveRecordingStartTime Then WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
End If
End Sub
Private Sub cmdStopTime_Click ()
Dim wrst As String
wrst = WaveRecordingStopTime
If wrst < WaveRecordingStartTime Then wrst = WaveRecordingStartTime + TimeSerial (0, 15, 0)
wrst = InputBox ("Enter stop time recording", "Stop time", wrst)
If wrst = "" Then Exit Sub
If Not IsDate (wrst) Then
MsgBox ("The time you entered was not valid!")
Else
String returned from InputBox is a valid time,
so store it as a date/time value in WaveRecordingStartTime.
If CDate (wrst) < WaveRecordingStartTime Then
MsgBox ("The stop time has to be later then the start time!")
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 5, 0)
Else
WaveRecordingStopTime = CDate (wrst)
End If
End If
End Sub
Private Sub Form_Load ()
Select Case Rate
Case 44100
optRate44100. Value = True
Case 22050
optRate22050. Value = True
Case 11025
optRate11025. Value = True
Case 8000
optRate8000. Value = True
Case 6000
optRate6000. Value = True
End Select
Select Case Channels
Case 1
optMono. Value = True
Case 2
optStereo. Value = True
End Select
Select Case Resolution
Case 8
opt8bits. Value = True
Case 16
opt16bits. Value = True
End Select
If WaveRecordingImmediate Then
optRecordImmediate. Value = True
Else
optRecordProgrammed. Value = True
End If
If WaveAutomaticSave Then
Option11. Value = True
Else
Option10. Value = True
End If
End Sub
Private Sub optRate11025_Click ()
Rate = 11025
optRate11025. Value = True
End Sub
Private Sub optRate44100_Click ()
Rate = 44100
optRate44100. Value = True
End Sub
Private Sub Option10_Click ()
WaveAutomaticSave = False
End Sub
Private Sub Option11_Click ()
WaveAutomaticSave = True
End Sub
Private Sub optRate22050_Click ()
Rate = 22050
optRate22050. Value = True
End Sub
Private Sub optRate8000_Click ()
Rate = 8000
optRate8000. Value = True
End Sub
Private Sub optRate6000_Click ()
Rate = 6000
optRate6000. Value = True
End Sub
Private Sub optMono_Click ()
Channels = 1
optMono. Value = True
End Sub
Private Sub optStereo_Click ()
Channels = 2
optStereo. Value = True
End Sub
Private Sub opt8bits_Click ()
Resolution = 8
opt8bits. Value = True
End Sub
Private Sub opt16bits_Click ()
Resolution = 16
opt16bits. Value = True
End Sub
Private Sub optRecordImmediate_Click ()
WaveRecordingImmediate = True
frmManualAuto. Visible = False
frmTimes. Visible = False
lblTimes. Visible = False
AudioRecorder. cmdRecord. Enabled = True
End Sub
Private Sub optRecordProgrammed_Click ()
WaveRecordingImmediate = False
frmManualAuto. Visible = True
frmTimes. Visible = True
lblTimes. Visible = True
AudioRecorder. cmdRecord. Enabled = False
If WaveRecordingStartTime < Now Then
WaveRecordingStartTime = Now + TimeSerial (0, 15, 0)
WaveRecordingStopTime = WaveRecordingStartTime + TimeSerial (0, 15, 0)
End If
End Sub
Option Explicit
Public Declare Function ShellExecute Lib "shell32. dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Public Rate As Long
Public Channels As Integer
Public Resolution As Integer
Public WaveStatusMsg As String * 255
Public WaveStatisticsMsg As String
Public WaveRecordingImmediate As Boolean
Public WaveRecordingStartTime As Date
Public WaveRecordingStopTime As Date
Public WaveRecordingReady As Boolean
Public WaveRecording As Boolean
Public WavePlaying As Boolean
Public WaveAutomaticSave As Boolean
Public WaveFileName As String
Public WaveMidiFileName As String
Public WaveLongFileName As String
Public WaveShortFileName As String
Public WaveRenameNecessary As Boolean
These were the public variables
=====================================================
Private Declare Function mciSendString Lib "winmm. dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrrtning As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function FindFirstFile& Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA)
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Type FILETIME 8 Bytes
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA 318 Bytes
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReservedЇ As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Function FileExist (strFileName As String) As Boolean
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFirst As Long
hFindFirst = FindFirstFile (strFileName, lpFindFileData)
If hFindFirst > 0 Then
FindClose hFindFirst
FileExist = True
Else
FileExist = False
End If
End Function
Public Function GetShortName (ByVal sLongFileName As String) As String
Dim lRetVal As Long, sShortPathName As String, iLen As Integer
Set up buffer area for API function call return
sShortPathName = Space (255)
iLen = Len (sShortPathName)
Call the function
lRetVal = GetShortPathName (sLongFileName, sShortPathName, iLen)
If lRetVal = 0 Then The file does not exist, first create it!
Open sLongFileName For Random As #1
Close #1
lRetVal = GetShortPathName (sLongFileName, sShortPathName, iLen)
Now another try!
Kill (sLongFileName)
Delete file now!
End If
Strip away unwanted characters.
GetShortName = Left (sShortPathName, lRetVal)
End Function
Private Function Has_Space (sName As String) As Boolean
Dim b As Boolean
Dim i As Long
b = False not yet any spaces found
i = InStr (sName, " ")
If i <> 0 Then b = True
Has_Space = b
End Function
Public Sub WaveReset ()
Dim rtn As String
Dim i As Long
rtn = Space$ (260)
Close any MCI operations from previous VB programs
i = mciSendString ("close all", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Closing all MCI operations failed!")
Open a new WAV with MCI Command...
i = mciSendString ("open new type waveaudio alias capture", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Opening new wave failed!")
End Sub
Public Sub WaveSet ()
Dim rtn As String
Dim i As Long
Dim settings As String
Dim Alignment As Integer
rtn = Space$ (260)
Alignment = Channels * Resolution / 8
settings = "set capture alignment " & CStr (Alignment) & " bitspersample " & CStr (Resolution) & " samplespersec " & CStr (Rate) & " channels " & CStr (Channels) & " bytespersec " & CStr (Alignment * Rate)
Samples Per Second that are supported:
11025 low quality
22050 medium quality
44100 high quality (CD music quality)
Bits per sample is 16 or 8
Channels are 1 (mono) or 2 (stereo)
i = mciSendString ("seek capture to start", rtn, Len (rtn), 0) Always start at the beginning
If i <> 0 Then MsgBox ("Starting recording failed!")
You can use at least the following combinations
i = mciSendString ("set capture alignment 4 bitspersample 16 samplespersec 44100 channels 2 bytespersec 176400", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 16 samplespersec 44100 channels 1 bytespersec 88200", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 4 bitspersample 16 samplespersec 22050 channels 2 bytespersec 88200", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 16 samplespersec 22050 channels 1 bytespersec 44100", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 4 bitspersample 16 samplespersec 11025 channels 2 bytespersec 44100", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 16 samplespersec 11025 channels 1 bytespersec 22050", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 8 samplespersec 11025 channels 2 bytespersec 22050", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 1 bitspersample 8 samplespersec 11025 channels 1 bytespersec 11025", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 8 samplespersec 8000 channels 2 bytespersec 16000", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 1 bitspersample 8 samplespersec 8000 channels 1 bytespersec 8000", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 2 bitspersample 8 samplespersec 6000 channels 2 bytespersec 12000", rtn, Len (rtn), 0)
i = mciSendString ("set capture alignment 1 bitspersample 8 samplespersec 6000 channels 1 bytespersec 6000", rtn, Len (rtn), 0)
i = mciSendString (settings, rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Settings for recording not consistent")
If the combination is not supported you get an error!
End Sub
Public Sub WaveRecord ()
Dim rtn As String
Dim i As Long
Dim msg As String
rtn = Space$ (260)
If WaveMidiFileName <> "" Then
If WaveRecordingImmediate Then MsgBox ("Midi file " & WaveMidiFileName & " will be recorded")
i = mciSendString ("open " & WaveMidiFileName & " type sequencer alias midi", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Opening midi file failed!")
i = mciSendString ("play midi", rtn, Len (rtn), 0) Start the recording
If i <> 0 Then MsgBox ("Playing midi file failed!")
End If
i = mciSendString ("record capture", rtn, Len (rtn), 0) Start the recording
If i <> 0 Then MsgBox ("Recording not possible, please restart your computer... ")
End Sub
Public Sub WaveSaveAs (sName As String)
Dim rtn As String
Dim i As Long
If file already exists then remove it
If FileExist (sName) Then
Kill (sName)
End If
The mciSendString API call doesnt seem to like
long filenames that have spaces in them, so we
will make another API call to get the short
filename version.
This is accomplished by the function GetShortName
MCI command to save the WAV file
If Has_Space (sName) Then
WaveShortFileName = GetShortName (sName)
WaveLongFileName = sName
WaveRenameNecessary = True
These are necessary in order to be able to rename file
i = mciSendString ("save capture " & WaveShortFileName, rtn, Len (rtn), 0)
Else
i = mciSendString ("save capture " & sName, rtn, Len (rtn), 0)
End If
If i <> 0 Then MsgBox ("Saving file failed, file name was: " & sName)
End Sub
Public Sub WaveStop ()
Dim rtn As String
Dim i As Long
i = mciSendString ("stop capture", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Stopping recording failed!")
If WaveMidiFileName <> "" Then
i = mciSendString ("stop midi", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Stopping playing midi file failed!")
End If
End Sub
Public Sub WavePlay ()
Dim rtn As String
Dim i As Long
i = mciSendString ("play capture from 0", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Start playing failed!")
End Sub
Public Sub WaveStatus ()
Dim i As Long
WaveStatusMsg = Space (255)
i = mciSendString ("status capture mode", WaveStatusMsg, 255, 0)
If i <> 0 Then MsgBox ("Failure getting wave status... ")
WaveStatusMsg = "AudioRecorder: " & WaveStatusMsg
End Sub
Public Sub WaveStatistics ()
Dim mssg As String * 255
Dim i As Long
i = mciSendString ("set capture time format ms", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting time format in milliseconds failed!")
i = mciSendString ("status capture length", mssg, 255, 0)
mssg = CStr (CLng (mssg) / 1000)
If i <> 0 Then MsgBox ("Finding length recording in milliseconds failed!")
WaveStatisticsMsg = "Length recording " & Str (mssg) & " s"
i = mciSendString ("set capture time format bytes", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting time format in bytes failed!")
i = mciSendString ("status capture length", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding length recording in bytes failed!")
WaveStatisticsMsg = WaveStatisticsMsg & " (" & Str (mssg) & " bytes)" & vbCrLf
i = mciSendString ("status capture channels", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding number of channels failed!")
If Str (mssg) = 1 Then
WaveStatisticsMsg = WaveStatisticsMsg & "Mono - "
ElseIf Str (mssg) = 2 Then
WaveStatisticsMsg = WaveStatisticsMsg & "Stereo - "
End If
i = mciSendString ("status capture bitspersample", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding resolution failed!")
WaveStatisticsMsg = WaveStatisticsMsg & Str (mssg) & " bits - "
i = mciSendString ("status capture samplespersec", mssg, 255, 0)
If i <> 0 Then MsgBox ("Finding sample rate failed!")
WaveStatisticsMsg = WaveStatisticsMsg & Str (mssg) & " samples per second " & vbCrLf & vbCrLf
End Sub
Public Sub WaveClose ()
Dim rtn As String
Dim i As Long
i = mciSendString ("close capture", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Closing MCI failed!")
End Sub
Public Function WavePosition () As Long
Dim rtn As String
Dim i As Long
Dim pos As String
rtn = Space (255)
pos = Space (255)
i = mciSendString ("set capture time format ms", rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Setting format in milliseconds failed!")
i = mciSendString ("status capture position", pos, 255, 0)
If i <> 0 Then MsgBox ("Finding position failed!")
If i <> 0 Then MsgBox ("Error in position")
WavePosition = CLng (pos)
End Function
Public Sub WavePlayFrom (Position As Long)
Dim rtn As String
Dim i As Long
Dim pos As String
pos = CStr (Position)
i = mciSendString ("set capture time format ms", 0&, 0, 0)
If i <> 0 Then MsgBox ("Setting format in milliseconds failed!")
i = mciSendString ("play capture from " & pos, rtn, Len (rtn), 0)
If i <> 0 Then MsgBox ("Playing from indicated position failed!")
If i <> 0 Then MsgBox ("Play from position doesnt work... ")
End Sub
Interface in Action
|
Заказать