Audio recorder on visual basic

AUTOMATIC SYSTEM AUDIISUAL BASIInterface 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 = &H2 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 & "

Don't 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 = &H2 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 doesn't 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 doesn't work ")

End Sub Interface in Action